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APPENDIX  A 
GLOSSARY  OF  TERMS 


A-1 


ARCHIVE 


DATA  BASE 
DATA  ITEM 

DIR 

EGS 

ELEC 

E.O. 

FIELDS 

FILE 

FORTRAN 

FUNIT 

GSE 


(1)  To  transfer  from  disk  to  magnetic  tape. 

(2)  To  save  or  put  away  data  where  direct  access  is  no 
longer  needed. 


A collection  or  set  of  data  files;  records. 

A subdivision  of  a data  record;  for  example,  author  and 
contract  number  are  data  items  or  fields  of  a memo  record. 

Design  Information  Release 

Electrical  ground  support  equipment 

Electrical 

Engineering  Order 


See  Data  Item 

Storage  area  on  disk  to  place  and  keep  a collection  of 
data  records  for  later  access. 

Special  language  used  to  give  instructions  to  the  computer. 
PRIMOS  file  unit  number 


Ground  support  equipment 


A-2 

1 


GUID 


Guidance 


HOUSEKEEPING 

H/S 

ID 

INPUT 

LOGIN 

MECH 

MESSAGE 

MFD 

MGS 

MODE 

OUTPUT 

PERF 

PRINTOUT 

PROP 


Process  by  which  the  computer  performs  program  instructions 
in  order  to  permit  smooth  operation  - for  example,  opening, 
closing,  and  deleting  files. 

Heatshield 


Identification 

To  place  data  into  a file. 

User  process  of  being  identified  to  the  computer  for 
further  operation. 


Mechanical 

A special  note  displayed  on  the  terminal  to  the  user  by 
the  computer  program. 

Master  File  Directory 

Mechanical  ground  support  equipment 

A type  of  task  for  a specific  job. 

To  show  or  display  data. 

Performance. 

A special  listing  of  data  provided  to  the  user  by  the 
computer  for  later  reference  or  use. 

Propulsion 


A-3 

f 


PUNIT 

RECORD 

REVISE 

RF 

SEARCH 

SOFTWARE 

SOP 

SPADS 

SPO 

SPOOLED 

SUBFILE 

TERMINAL 

UFD 

USER 

W.A. 


Fortran  file  unit  number 

A subdivision  of  a file  consisting  of  a set  of  data 
items  from  a document. 

To  change  or.  modify  data. 

Radio  frequency  for  telemetry  system 

To  find  or  locate  a specific  set  of  data;  records. 

A group  or  set  of  fixed  computer  instructions  designed 
to  perform  special  tasks. 

Standard  operating  procedure 

Scout  Project  Automatic  Data  System 

Scout  Project  Office 

Process  by  which  the  computer  transfers  a special  output 
file  to  the  printer  for  a printout. 

A part  or  subdivision  of  a file. 

A device  with  typewriter  keys  used  to  communicate 
with  the  computer. 

User  File  Directory 

Any  person  initiating  interaction  with  the  computer. 

Work  authorization 
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PAGE  0001 


03 

I 

00 


(0001) 

C 

(0002) 

C 

HAIL  LOG  FILE 

(0003) 

c 

WRITTEN  FOR  NASA/LRC/SPO 

BY  D.K. HARRIS 

(OOCA) 

c 

HAMPTON  SCOUT  OFFICE 

(0005) 

c 

VOUGHT  CORP- 

(0006) 

c 

(0007) 

COMMON  /CDAT/CD 

(0006) 

c 

FILES  FOR  READING  AND  WRITING 

(0009) 

c 

(0010) 

c 

FILE  FUNIT 

PUNIT 

DESCRIPTION 

(0011) 

c 

TTY  1 

1 

USERS  TERMINAL 

(0012) 

c 

TRAN  6 

2 

DATA  SUBFILE  FOR  TRANSMITTAL  AND  SPECFICATION 

(0013) 

c 

OUT  7 

3 

TEMPORARY  OUTPUT  FILE 

(OCIA) 

c 

REVS  8 

A 

TEMPORARY  REVISION  DATA  FILE 

(0015) 

c 

INACTL  9 

5 

INACTIVE  FILE  FOR  ARCHIVE  RUN  OF  TRAN  SUBFILE 

(0C16) 

c 

INACTS  9 

5 

INACTIVE  FILE  FOR  ARCHIVE  RUN 

(0017) 

c 

ACTD  9 

5 

ACTION  DUE  FILE 

(0018) 

c 

DATE  10 

6 

TEMPORARY  DATE  FILE 

(0019) 

c 

MEMO  11 

7 

DATA  SUBFILE  FOR  MEMOS  AND  LETTERS 

(0020) 

c 

TWFX  12 

8 

DATA  SUBFILE  FOR  TW X S , H AGN AF A X, & RAPIFAX 

(0021) 

c 

ANN  13 

Q 

DATA  SUBFILE  FOR  ANNOUNCEMENTS 

(0022) 

c 

PR  lA 

10 

DATA  SUBFILE  FOR  PURCHASE  REQUESTS 

(0023) 

c 

HIS  15 

11 

DATA  SUBFILE  FOR  MISCELLANEOUS  AND  REPORTS 

(OOPA) 

c 

(0025) 

c 

NOTE  ONLY  FILES 

TTY, REVS 

, AND  DATE  (FUNITS  1,8,10)  ARE  OPENED  HERE 

(0026) 

c 

(0027) 

DOUBLE  PRECISION  CD 

(0028) 

INTEGER«2  DFFA, 

IPAS(3),IC 

(0029) 

c 

(0030) 

c 

• 

(0031) 

c 

SYSCOK>KEYS.F 

MNEMONIC 

KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(0031) 

NOLIST 

(0032) 
(0033) 
( 0 03*4  ) 
(0035) 
(003G) 
(0037) 


100 


CALL  DREAKK. FALSE.) 

CALL  CLEAR 

CALL  COMISK’TTY*  .3,12,10 
WRITFd.lOO) 

FORHAT(»  WELCOME  TO  SPADS*/////, 
!•  MAIL  LOG  FILE  •,/) 


R-4 


c 


<0038J.  200  URITE(1.250> 

<0039)  250  F0RHATC2X.*  ♦♦/,»  DO  YOU  WISH  TO  WORK  WITH  THE  DIR/REPORT  DATA  •» 

<C0A0)  1 * ENTER  DI R »♦ / t 26Xt • OR  DRAWING  DATA»,5X,» ENTER  DRAW*»/»26X 

<00*1)  I ♦•OR  DAILY  CORRESPONDENCE  C OR ♦ , / ♦ 26X ♦ • OR  QUIT** 

<oo'.2)  iiext* — au*) 

<O0A3)  READCl  tlDIOPT 

(OOAA)  IF(IOPTiE(J.*QU*)  GOTO  1200 

<0DA5)  IFCIOPT.EQ. *CO*  ) GOTO  ROO 

(ODAb)  IPAS(1>=»  • 

<00A7)  IPAS(2)=»  * 

(OOAfl)  IPAS(3)=»  • 

<0049)  IF(IOPT.EQ.*DR»)  GOTO  700 

<0050  IFCIOPT.NE.  •DI»)  GOTO  200 

<0051)  CALL  ATCHJl(*F_DIR**5*K$ALLDtIPAS*KSIMFD^KSSETH*IC) 

<005?)  CALL  RESU5S(**DIR* *4) 

<0053).  CALL  EXIT 

(0054)  700  CALL  ATCHS t ( *F_DR AW • *6 %K$ ALLD t IPAS *K$IHFO+K JSETH ♦ IC ) 

<0055)  CALL  RESUSK »»DRAW**5) 

(005t)  CALL  EXIT 

(0057)  eoo  CONTINUE 

(0058)  CALL  SPCHSJ (K$RDUR+KSNDAHf»REVS  •*6*4tltIC) 

(0059)  IF(IC.NE.O)  GOTO  1000 

(OObO)  CALL  SRCH$t<KSRDUR+K$NDAMt»DATE  •♦6»6»1»IC) 

(OObl)  IF(IC.NE.O)  GOTO  1000 

(0062)  c : 

(00G3)  C 1000  IS  THE  ERROR  HANDLER 

(0064)  ■ C 

(0065)  C IF  THE  PROGRAM  REACHES  THIS  FAR  THE  FILES  ARE  OPEN  AND  USABLE 

(0066)  C 

(0067)  889  CALL  CLEAR 

(0068)  CALL  IDENT 

(0069)  10  URITE(1*2) 

(0070)  2 FORMAK*  PLEASE  CHOSE  ONE  OF  THE  FOLLOWING  ♦,/♦ 


(0071)  1»  MODE  Kf Y»f/t 
(0072)  1»  INPUT  INP*t/t 
(0073)  1*  REVISE  RFV»*/» 
(0074)  !•  SEARCH  SEA**/, 
(0075)  1*  ARCHIVE  ARC**/, 


(0076)  1*  QUIT  QUIT*,//) 

(0077)  REWIND  B 

(007fl)  REWIND  10 

(0079)  READ(1,11)I0PT 

(0080)  11  F0RMAT(1A2) 

(OOBl)  IF(IOPT.EQ.*IN*)  CALL  INPTC 

(0082)  1F( lOPT.EC. *RE* > CALL  REVSC 

(0083)  IFdOPT.EQ.  »SE*)  CALL  SEAC 

(0089)  If (IOPT.EG.*AR*)  CALL  ARCC 

(0089.)  IF(  IOP7.EG.  *&U*  ) . GO  TO  1100 

(0086)  ‘ GO  TO  in 

( 0087)  10  00  URITEd.lOOl) 

( 0083)  1001  FORM.AT(*  SORRY  - THF  MAIL  LOG  FILE  IS  CURRENTLY  IN  USE*»/» 

(0009)  1*  PLEASE  TRY  AGAIN  LATER*,///) 

(0090)  1100  CALL  SRCHSS (KSCLOS, *REVS  *,6,0, 0,0) 

(0091)  CALL  SRCHSS(KSCLOS, ‘DATE  *,6,0, 0,0) 

_ f (0092)  GO  TO  200 

Oi  (0093)  1200  CALL  EXIT 

(0099)  END 


B-6 


PAGE  OOOA 


ARCC 
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EXTERNAL  000000 
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EXTERNAL  000000 
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R 

external  000000 
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ro 
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/COAT/  000000 

C007E 

0027S 

CLEAR 

R 

EXTERNAL  COOOOO 

0033 

0067 

COM !$S 

R 

EXTERNAL  OOOOOD 

003A 

DRFA 

I 

OOOOOO 

oozes 

EXIT 

R 
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0093 

IC 

I 
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I 
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I 
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lOPT 

J 
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0044 

0045 

0049 
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0079H 

00P2 

0083 

0084 

0085 

IPAS 

I 

000002 

0028S 

C046M 

0047H 

0048H 

0051A 

0O54A 

KIALLO 

I 

PARAMETER 

0031  S 

0051 

0054 

KSCACC 

1 

parameter 

0031S 

KICLOS 

I 

PARAMETER 

C031S 

0090 

0091 

KSC3NV 

I 

PARAMETER 

0031E 

KJC'JRR 

I 

PARAMETER 

003ir 

KSDELE 

I 

PARAMETER 

0031S 

KSOMPB 

I 

PARAMETER 

P031S 

KSLTIM 

I 

PARAMETER 

0031S 

KIENTR 

I 

OOOOOO 

0031  S 

KSEXST 

I 

PARAMETER 

0031S 

KSGO.^JD 

I 

PARAMETER 

0031S 

KIGPOS 

I 

PARAMETER 

00  31  S' 

KSHOME 

I 

PARAMETER 

0031  S 

KlICUR 

I 

PARAMETER 

0031S 

KSIMFD 

I 

PARAMETER 

0031S 

0051 

0054 

• 

KSIRTN 

I 

PARAMETER 

C031S 

KSISCG 

I 

PARAMETER 

0031  b 

/ 

, 

KIIUFD 

I 

PARAMETER 

D031S 

KSHENT 

I 

OOOOOO 

0031  S 

KSHSIZ 

I 

PARAMETER 

0031S 

KiMVNT 

I 

PARAMETER 

0031S 

KS^rJAM 

I 

PARAMETER 

0031  S 

0058 

0060 

kin:rtn 

I 

PARAMETER 

0031S 

) 


KSNSAH 

1 

parameter 

0031S 

KSNSGD 

I 

PARAMETER 

0031S 

KJNSGS 

I 

PARAMETER 

0031  S 

KSPOSA 

I 

PARAMETER 

0031  S 

KSPOSN 

I 

PARAMETER 

C031S 

KI PCSR 

I 

PARAMETER 

00  31K 

XIPREA 

I 

PARAMETER 

0031S 

KIPRER 

I 

PARAMETER 

C0  31S 

KSPROT 

I 

PARAMETER 

0031  S 

KSRUUR 

I 

PARAMETER 

00  31S 

0058 

0060 

KIREAO 

I 

PARAMETER 

0031  S 

lURPOS 

I 

PARAMETER 

0031  R 

K5RSUU 

I 

PARAMETER 

0031  R 

KSR'JLK 

I 

P AR AMETER 

no3ir; 

KlSl MT 

I 

nooooo 

00  3 IS 

KSSE.TC 

I 

PARAMETER 

0031  S 

KJ SlTH 

I 

PARAMETER 

00  31  S 

0051 

005A 

KISPCS 

I 

P AR AMETER 

C0  31S 

KISRTN 

I 

PARAMETER 

C031S 

KITRriC 

I 

PARAMETER 

0031  S 

KlUPOS 

I 

P AR AMETER 

0031  S 

Kl'.'R  IT 

I 

PARAMETER 

0031  S 

RESUSS 

R 

EXTERNAL  000000 

0052 

0055 

REVSC 

R 

EXTERNAL  000000 

0002 

SEAC 

R 

EXTERNAL  000000 

0083 

SRCHSS 

R 

EXTERNAL  (lOOOOO 

0058 

0060 

0090 

_io 

D003A2 

00  60D 

0086 

_100 

000023 

0035 

00360 

coo 

00057A 

0059 

0061 

0087D 

1001 

000600 

0087 

00880 

_11 

000537 

00A3 

00  79 

00800 

_1100 

000652 

0085 

00900 

_1200 

000673 

00  AA 

00930 

~2 

r,00  3A6 

0069 

C0700 

~2  0 0 

00005A 

00  3fn 

0050 

0092 

^250 

000060 

00  38 

C039O 

~700 

00027  A 

00  A9 

005AD 
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800 


000311  0045  0057D 

000340  00670 


0000  ERRORS  C <.M AI N.>FTN-REV 14 .2 3 


ULROUTU'E  IDENT 


03 

VO 


(009b) 
(0096) 
(0097) 
(0098) 
(0099) 
(0100) 
(0101) 
(0101) 
(0102) 
(0103) 
(OIC‘1) 
(0105) 
(0106) 
(0107) 
(0108) 
(0109) 
(0110) 
(0111) 
(0112) 
(0113) 
(0114) 
(0115) 
(0116) 
(Oil?) 
(0110) 
(0119) 
(0120) 
(0121) 
(0122) 
(0123) 
(0124) 
(0125) 
(0126) 
( 0 .1  2 7 ) 
(0128) 
(0129) 
(0130) 
(0131) 


SUBROUTINE  IDENT 
C 

C THIS  ROUTINE  KEEPS  TRACK  OF  WHO  ACCESSED  THE  CALLING 

C PROGRAM  LAST 

C 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


INTEGER*P  ARRAY(lb) 

SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY.  1977 

NOLIST 

CALL  BREAKl ( -TRUE.  ) 

CALL  TIHDAT (ARRAY. 1 5) 

OPEN  TEMP  FILE  (FUMT  16) 

CALL  SPCHSS (KINDAH+KIRDUR.’TUSER *.5.16,1.10 
OPEN  USER  FILE  (FUNIT  15) 

CALL  SRCHJt (KSNDAM+KSRDWR. *USEP* .4.15, 1, 1C) 

NOW  WRITE  USERS  LOGIN  ID.  DATE  (HMDDY).  TIME,  AND  USER  NUMBER 

AHIN  = ARRAY(  *) 

AH=AMIN/60.0 

IHrAH 

IKH=IH*60 

IMIN=AKIN 


IDM=IM1N-IHM 

25  WRITE(20.1)(ARRAY(I).I=13,lb).IH,IOM.ARRAY(b). 

1 (ARRAY(I), 1=1.3). ARRAY(12) 

1 F0PHAT(3A2.2(13.*:*).I3.1X.2(A2.*/*).A2.I3)  . 

2 F0RHAT(3A2.2(I3.1X).I3.1X,2(A2.1X).A2.I3) 

C 

C NOW  COPY  THE  CONTENTS  OF  USER  TO  TUSER 

C 


READ(19.2.END=50)(AkRAY(I).I=13.1b),IH.IDM.ARRAY(5), 
1 (ARHAY(I).I=1.3).ARRAY(12) 

GO  TO  25 

50  CALL  SRCHU(KJCLOS,*USrR*,4.0.0.0) 


OL-a 


(0132) 

(0133) 

(0i3‘l) 

(0135) 

(C1361 

(0137) 


SUBROUTINE  IDEMT 


PAGE  0008 


CALL  SHCHSS(KJCLOS»»TUSFR»«5»0»0f0) 
CALL  SRCHJ$(KiDELE« ’USER’ »4,0.0«0) 
CALL  CNAHIK  • TUSER  • » b » * USER  • * A * I C ) 
CALL  BREAK! r .FALSE. ) 

RETURN 

END 


( 


: ..  ■ — i 

^ ^ ) ' ■ J 

fc  • t t 


B-n 


subroutine:  ident 


AH 

R 

0003A7 

0116M 

0117 

AMIN 

R 

000351 

0115M 

0116 

0119 

ARRAY 

I 

00000? 

OlOOS 

0103A 

0115 

BREAKS 

R 

EXTERNAL  000000 

010? 

0135 

CNAMSS 

R 

EXTERNAL  000000 

C13A 

I 

I 

000353 

0 1 2 1 M 

0128M 

IC 

I 

0 00 35  A 

0107A 

OlllA 

013AA 

IDEfJT 

1 

COOOOO 

0095S 

lOH 

I 

000355 

0120M 

0121 

0178M 

IH 

I 

000358 

C117M 

0118 

0121 

IrllN 

I 

000357 

0119M 

0120 

IHK 

I 

C00300 

OIUM 

0120 

K$ ALLD 

I 

PARAMETER 

0101  s 

KSCACC 

I 

PARAMETER 

01  OIF. 

KICLOS 

I 

PARAMETER 

0101  s 

C131 

0132 

KSCOMV 

I 

PARAMETER 

01  OIF 

KSCURR 

I 

PARAMETER 

■ nioiF 

KSDELE 

1 

Parameter 

OlOlS 

0133 

KSDHPE 

I 

PARAMETER 

OlOlS 

KIDTIM 

I 

PARAMETER 

01  OIF 

KSEfJTR 

1 

000000 

OlOlS 

KJ  EXST 

I 

PARAMETER 

OlOlS 

KSGOND 

I 

PARAMETER 

CIOIS 

KSOFCS 

I 

PARAMETER 

OlOlS 

KSHOHE 

I 

PARAMETER 

OlOlS 

KS'ICUR 

I 

PARAMETER 

CIOIS 

K $ 1 B F D 

I 

PARAMETER 

CIOIS 

KSIRTK 

I 

PARAMETER 

CIOIS 

KSISEG 

I 

PARAMETER 

GIOIS 

K$  lUFD 

I 

PARAMETER 

OlOlS 

KSMENT. 

I 

000000 

CIOIS 

KSHSI2 

I 

PARAMETER 

OlOlS 

KSMVNT 

I 

PARAMETER 

CIOIS 

KSNOAH 

I 

PARAMETER 

CIOIS 

0107 

0111 

KlNRTfJ 

I 

P ARAMETER 

OlOlS 

KIASAM 

I 

PARAMETER 

CIOIS 

KSNSGD 

I 

PARAMETER 

niQi  s 

KSNSGS 

I 

PARAMETER 

OlOlS 

0121  0128H 


0128H 


SUBROUTINE  IDENT 
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KJPCSA 

1 

PARAMETER 

0101  S 

KSPOSN 

1 

PAftAHtTER 

OlOlS 

KSPOSR 

1 

parameter 

0101  S 

KSPREA 

1 

PARAMETER 

OlOlS 

KSPRER 

I 

PARAMETER 

OlOlS 

KIPROT 

I 

PARAMETER 

PIOIS 

KJRL'UR 

I 

PARAMETER 

01  OIS 

0107 

KJREAD 

I 

PARAMETER 

oioir. 

KiRPOS 

I 

PARAMETER 

OlOlS 

KSRSUB 

I 

PARAMETER 

OlOlS 

KIRU'LK 

I 

PARAMETER 

OlOlS 

KJSENT 

I 

000000 

Cl  01s 

KSSETC 

I 

PARAMETER 

OlOlS 

KSSETH 

I 

PARAMETER 

0101s 

KSSPOS 

I 

P ARAKETER 

OlOlS 

KSSRTN 

I 

PARAMETER 

CIOIS 

KlTRfJC 

1 

parameter 

OlOlS 

K SUP OS 

I 

Parameter 

0101  s 

KS'.RIT 

I 

PARAMETER 

01  OIS 

SRCHSS 

R 

EXTERNAL  000000 

010  7 

0111 

TIMDAT 

R 

EXTERNAL  000000 

0103 

_1 

000157 

0121 

01230 

I2 

, . 000203 

012AO 

0128 

25 

C00077 

C121D 

0130 

5C 

00030A 

0128 

01310 

OOCO  ERRORS  C<IDENT  >FTN-REV1A.2 1 
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(0138)  SUBROUTINE  TINPUT ( I T1 , LEN) 

(0139)  C 

(0190)  C TITLE  PACK  ROUTINE 

(0191)  C 
(0192)  C 

(0192)  C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

(0192)  C 

(0192)  COHMON/BLK/  MS t ATHR , DD , TO , DLN . SUB , ROUT 1 1 DD t CUA  ,CONT « 

(0192)  1 ADD* TUX*FSC»NRL»OnT*R«PTIT»COUNT»CON 

(0192)  COMMON/SRC/  KNT ,DH » DA t DDO » D TO, OL» 1 T , 0* U A »DU, DT ,DRE 

(0192)  ' 1 ,TFVD,TLVD,FVD,LVO,IEX 

(0192)  COMMON/FLA/  1 TRSP , I HELE , I TWFX , I ANN , IPR , I M I S , I R E AD 

(0192)  1NTEGER«9  ATHR(7),T0(8),DLN(5),SUD(21) .ROUT (6) ,PTIT (19) » 

(0192)  1 C0N(5), TUX(6,5) ,FSC(6) ,NRF(1 ,3) ,DDT( 30,21) »T(21> 

(0192)  1 ,T  IT(29) .COUNT ,C0NT(5) ,IEX(9,3) 

(0192)  INTEGER*2  MS  , DD ( 3 ) , I DO ( 3 ) , ADD ( 3 ) , R , CU A ( 9 ) , WA ( 9 ) 

(0192)  INTEGER  *2  I TRSP  , I ME  LE  , IT'J  F X , I ANN  , I PR  , I H IS  , I RE  AD 

(0192)  IN'IEGER*2  F VD  ( 3 ) , L V D ( 3 ) , D ( 3)  , DM  , ODD  ( 3 ) 

(0192)  1NTEGER*9  DR  £ ,0 T ( 5 ) , C U ( 5 ) ,DL ( 5 ) , D A ( 7 ) , I T ( 29 ) , DTO ( 8) , KNT 

(0192)  DOUBLE  PRECISION  DT J , TF , T L , T JUL , T F VD , TL VO, TI M, T J 

(0193)  COMMON  /X/PEDL 

(0199)  INTEGER*9  ARRA Y (9 ) , BLNK 

(0195)  INTEGER*9  1TK21) 

(0196)  INUGER*2  PEDL,  B UF  ( 76  ) ,GUF  F ( 76  ) 

(0197)  CALL  RDCOM(i;UF) 

(019F)  DO  5 1=1,76 

(0199)  BUFF  (I )=BUF (I ) 

(0150)  5 CONTINUE 

(0151)  BLNK=»  • 

(0152)  DO  1 1=1,29 

(0153)  1 TIT(1)=BLNK 

(0159)  DO  11  1=1,20 

(0155)  ARRAYd  ) = tlLNK 

(0156)  ARRAY(2)=BLNK 

(0157)  ARRA Y(3)=BLNK 

(0158)  ARRAY(9)=BLNK 

(0159)  CALL  GFTWRD (DUF, ARRAY, LEN) 

(0160)  T1T(I)=ARRAY(1) 


t?l-9 


SUCROUTINE  TINPUT(ITItLEN) 


(0161) 

T1T(I*1 )=ARRAY(?) 

(016?) 

TIT( I*?)=ARRAY( 3) 

(0163) 

TIT( I*3)=ARRAY(4) 

(0164) 

1 = 1 + 2 

(0165) 

12 

COtJTINUE 

(0166) 

11 

CONTINUE 

(0167) 

FEDL=1 

(0168) 

DO  100  1=1.21 

(0169) 

ITI(I)=TIT(I) 

(0170) 

100 

CONTINUE 

(0171  ) 

DO  200  1=1.19 

(0172) 

200 

PTIT(I)=BLNK 

(0173) 

CALL  GETWO(BUFF.PTIT) 

(0174) 

211 

CONTINUE 

(0175) 

RETURN 

(0176) 

END 

) ) 
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SUfiROUTINE  TINPUT(ITItLCN) 
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ADD 

1 

/BLK/ 

000163 

0142S 

ARRAY 

J 

000006 

0144S 

0155H 

0156H 

0157H 

0158M 

0159A 

0161 

0162 

0163 

ATHR 

J 

/E-LK/ 

000001 

0142B 

BLNK 

J 

000601 

0144S 

0172 

0151M 

0153 

0155 

0156 

0157 

EUF 

I 

000016 

01465 

0147A 

0149 

0159A 

BUFF 

I 

C00132 

0146S 

0149K 

0173A 

CCN 

J 

/ELK/ 

002731 

0 1 4 2 S 

COM 

J 

/BLK/ 

000151 

0142S 

COUNT 

J 

/BLK/ 

002727 

0142S 

CUA 

I 

/E'LK/ 

0001A5 

0142S 

o' 

I 

/SRC/ 

000136 

0142S 

DA 

J 

/SRC/ 

000003 

C142S 

• 

DD 

I 

/DLK/ 

000017 

0142S 

ODD 

I 

/SRC/ 

000021 

0142E 

DDT 

J 

/BLK/ 

00n30A 

0142S 

DL 

J 

ysRc/ 

OOC04A 

0142S 

OLN 

J 

/DLK/ 

0000A2 

0142S 

DM 

I 

/SRC/ 

000002 

0142S 

ORE 

J 

/SRC/ 

000171 

0142S 

OT 

J 

/SRC/ 

000157 

0142S 

DT  0 

D 

000000 

0142S 

DTO 

J 

/SRC/ 

OOOOPA 

0142S 

DU 

J 

/SRC/ 

0001A5 

0142S 

FSC 

J 

/DLK/ 

000262 

0142S 

FVD 

I 

/SRC/ 

000203 

C142S 

GETWO 

R 

EXTERNAL 

000000 

0173 

6ETURD 

R 

EXTERNAL 

000000 

CID'^ 

I 

I 

C00603 

0148M 

0149 

0152M 

0153 

015-4M 

0160 

0162 

0163 

0164H 

0168H 

0169 

0171M 

I ANN 

1 

/FLA/ 

000003 

0142S 

IDO 

I 

/DLK/ 

000142 

0142S 

lEX 

J 

/SRC/ 

000211 

0142S 

IMELE 

I 

/FLA/ 

000001 

0142S 

IMIS 

I 

/FLA/ 

000005 

0 1 4 2 S 

IFR 

I 

/FLA/ 

000004 

0142S 

IREAO 

1 

/FLA/ 

000006 

0142S 

0160 

0158 


0161 

0172 


SUEROUTINE  T INPUT ( I TI »LEN ) 


IT 

0 

/SRc/ 

000056 

0142S 

ITI 

J 

Argument 

000003 

013BS 

0145S 

ITRSP 

I 

/FLA/ 

000000 

0142S 

ITWFX 

1 

/FLA/ 

000002 

0142S 

KfJT 

J 

/SRC/ 

000000 

C142S 

LEN 

I 

ARGUMENT 

000004 

0136S 

0159A 

LVD  . 

I 

/SRC/ 

000206 

0142? 

HS 

I 

/ELK/ 

Qonooo 

0142.*- 

NRE 

J 

/ELK/ 

00027G 

0142S 

PEDL 

I 

/y/ 

000000 

0143S 

0146S 

PTIT 

J 

/ELK/ 

002661 

0142S 

ni72M 

R 

1 

/ELK/ 

002660 

0142S 

RDCOM 

k 

EXTERNAL 

CfOOOOO 

0147 

ROUT 

J 

/ELK/ 

000126 

0142S 

SUB 

J 

/ELK/ 

000054 

0142S 

T 

J 

000246 

0142S 

TF 

0 

/SRC/ 

000000 

0142S 

TFVD 

0 

000173 

014PS 

TIH 

0 

000000 

0142S 

a\ 

TINPUT 

R 

GOO  COO 

0138S 

TIT 

J 

000320 

C142S 

0153M 

TJ 

D 

OOOQOG 

0142S 

• TJUL 

D 

CCOCOO 

01  42? 

TL 

0 

000000 

0142S 

TLVO 

D 

/SRC/ 

000177 

0142S 

TO 

J 

/ELK/ 

000022 

0142S 

TW  X 

J 

/ELK/ 

000166 

0142S 

UA 

I 

/SRC/ 

000141 

0142S 

_1 

000430 

0152 

0153D 

100 

000543 

0168 

01700 

000514 

0154 

01660 

-12 

000514 

0165D 

200 

000554 

0171 

01720 

_211 

000577 

0174D 

000411  0148 


0169H 


0167H 

0173A 


0160H 


0161H 


0162M 
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c READ  one:  line:  from  consolf  or  command  file: 


(0177) 

C 

READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 

(0178) 

C 

(0179) 

C 

(0180 

SUBROUTINE  RDCOM(BUF) 

(0181) 

C 

(0162) 

COMMON  /X/  PEDL 

(0183) 

C 

(ClftA) 

INTEGER  RUF(l) ,PEDL.CHAR,ANL,AKILL*AERASE 

(OlSEi) 

C 

(0180 

C 

ANL,  AKILL,  AERASE  ARE  OCTAL  212,  277,  2A2 

(0187) 

DATA  ANL  , AKILL, AEPASE/138, 191 ,136/ 

(0188) 

C 

(0189) 

PEDL=1 

(0190) 

90 

N=1 

(0191) 

100 

CALL  CIIN(CHAR) 

(0192) 

BUF(N)=CHAR 

(0193) 

IF  (CHAR. EQ. ANL)  RETURN 

(C19A) 

IF  (CHAR  .EQ. AKILL)  GOTO  90 

<C19b) 

IF(CHAR.EQ. AERASE)  GOTO  200 

(0196) 

N = N + 1 

(0197) 

IF(N.GT.77)  G0T0999 

(0198) 

GOTO  100 

(0199) 

C 

(0200) 

200 

IF (N.LE.2)  GOTO  90 

(0201  ) 

N = N-1 

(0202) 

GOTO  100 

(0203) 

C 

(020A) 

C 

(020b) 

C 

LINE  LONGER  THAN  77  CHAR 

(0206) 

c 

(0207) 

999 

ILF=:212 

(0208) 

CALL  TIOU(ILF) 

(0209) 

R1 TURN 

(0210) 

END 

B-18 


C READ 

ONE  LINE 

FROM  CONSOLE  OR 

COMMAND 

FILE 

AERASE 

1 

000007 

018AS 

01871 

0195 

AKILL 

I 

000006 

018AE 

C187I 

0194 

ANL 

I 

000005 

C18AS 

C187I 

0193 

BUF 

I 

ARGUMENT 

000003 

OIPOS 

0189S 

0192M 

CUN 

R 

EXTERNAL 

nooooo 

0191 

CHAR 

I 

000071 

01895 

0191  A 

0192 

0193 

ILF 

I 

000072 

C207M 

0208A 

N 

I 

000073 

C190M 

0192 

0196M 

0197 

PEDL 

I 

/X/ 

000000 

0182  S 

C189S 

D189H 

RDCOH 

R 

000000 

OlFCS 

TlOU 

R 

EXTERNAL 

000000 

0208 

ICiO 

000016 

0191D 

0198 

0202 

20C 

000051 

0195 

0200D 

90 

000013 

0190D 

0194 

0200 

999 

000062 

0197 

0207D 

OCOO  ERRORS  CCRDCOM  >FTN-REV1'I.23 
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019A  0195 

0200  0201M 


c 


FETCH  ONE  *UORD»  FROM  BUFFER  FILLED  BY  ROCOH 
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C0211) 

C 

FCTCH  ONE  ’WORD*  FROM  PUFFER  FILLED  BY  RDCOM 

(0212) 

C 

(0213) 

C 

(021A) 

SUBROUTINE  GE T WRD ( BUF ,N AHEtLEN) 

(0215) 

C 

(0216) 

COMMON  /X/  PEDL 

(0217) 

C 

(0;>1  P) 

INTEGER  BUF(l) ♦ PEDL, NAME(l), CHAR, 

(02?9) 

+ ANL,ACOMHA,ASCOL,ASP,ASPSP 

(0220) 

c 

( 0 2 1 ' 

t 

AML,ACOMMA,ASCOL, ASP,ASPSP 

(0222) 

c 

ARE  OCTAL 

(0223: 

c 

212,254,273,240,120240 

(cao'tj 

c 

(0225) 

DATA  ANL,ACOMMA,ASCOL/138,172,187/, 

(0226) 

♦ ASP,ASPSP/160,2H  / 

(0227) 

c 

(022B) 

DO  100  1=1,3 

(0229) 

100 

NAMEd  )=ASPSP 

(0230) 

c 

(0231) 

N=1 

(0232) 

IF(EUFd)  .NE.ASP)  GO  TO  200 

(02-)3) 

DO  999  1=2,77 

(02',4) 

11=1-1 

(0235) 

BUFdl  )=BUF  (I  ) 

(0256) 

999 

CONTINUE 

(0237) 

200 

CHAR=EUF(PEDL) 

(0238) 

PEDL=PLDL+1 

(0239) 

IF(PEDL.GT.77;  RETURN 

(0240) 

IF(CHAR.EQ. ANL ) GOTO  400 

(0241  ) 

IF(CHAR.EQ.  ASP.OR.CHAR.EQ.ACOMMA.OR.CHAR.EO.ASCOL)  GOTO  300 

(0242) 

IF(N.GT.LEN)  GOTO  200 

(0243) 

I = (N  + 1 )/2 

(0244) 

J=N-2«(N/2) 

(0245) 

N = N + 1 

(0246) 

lE(J.EO.l)  GOTO  250 

(0247) 

MAHE(I)=LT(NAMr(I) ,8)  , CHAR 

(0246) 

GOTO  2C0 
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(0rrA9J  250  NAHEtI>=  RT(VAHE(1)»8)  ♦ LS{CHAR»fi) 

(0250)  GOTO  200 

(0;?51)  C 

(0252:  300  CHAR=BUF(PEDL) 

(0253'  IF(CHAR.EQ. AND  GOTO  AOO 

(.025'!'  IF  (CHAR.NE.  ASP.  AND.  CHAR.  NE.ACOMMA.  AND. CHAR.  NE.ASCOL)  RETURN 

(0255)  PEDL=FEDL+1 

(C25f.)  GOTO  3D0 

(0257)  C 

(0258!  'too  PEDL=77 

(0259)  RETURN 

(02GO)  C 

(C261)  END 


c 


FETCH  OWE  ‘WORD*  FROM  BUFFER  FILLED  BY  ROCOH 


ACOMHA 

I 

000010 

021RS 

02251 

0241 

0254 

ANL 

I 

000007 

0218S 

02251 

0240 

0253 

ASCOL 

I 

OOOOU 

0218S 

02251 

0241 

0254 

ASP 

I 

000012 

02  IRS 

02251 

0232 

0 2.41 

ISPSP 

I 

000013 

021RS 

02251 

0229 

BUF 

I 

ARGUMENT 

000003 

0214S 

0218S 

0232 

0235M 

:har 

I 

000243 

0218S 

0237M 

0240 

0241 

0253 

0254 

OETVRD 

R 

000000 

0214S 

1 

I 

000244 

022BH 

C249 

0229 

0233H 

0234 

I I 

I 

000246 

0234M 

0235 

J 

I 

000247 

0244M 

0246 

LEW 

I 

ARGUMENT 

000005 

0214S 

0242 

LS 

I 

EXTERNAL 

000000 

0249 

LT 

I 

EXTERNAL 

000000 

0247 

N 

1 

000252 

C231M 

0242 

0243 

0244 

NAME 

I 

ASSUhent 

000004 

0214S 

0218S 

0229M 

0247H 

PEOl. 

I 

/X/ 

000000 

C21GS 
02  5 O' M 

0218S 

0237 

0238H 

KV 

R 

EXTERNAL 

000000 

02  4 9 

_10ii 

000017 

0228 

02290 

_200 

000070 

0232 

02370 

0 2 42 

0248 

I25J 

000174 

0246 

02490 

_300 

000207 

0241 

02520 

0256 

_400 

000240 

0240 

0253 

025RO 

_999 

COOOOl 

0233 

02360 

0000  ERRORS  C <GETURD>FTN-RE VI 'i . 2 J 


0254 

0237 

0247 


0235 


0245M 

0249M 

0239 


0250 


0252 

0249 

0243M 

0252 


0252M 

0247 

0255M 
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( 0?62) 

SUBROUTINE  GETU0(BUFF,NAHE) 

(0?65i 

C 

(02&A 1 

COHMON  /X/  PEDL 

(0265) 

C 

(02o6) 

INTEGER  BUFF(l) ,PEDL,NAHE(1),CHAR, 

(0267) 

♦ ANL,ACOKMA,ASCOL,ASP»ASPSP 

(0268) 

C 

<0269> 

C 

ANLfACOMMA, ASCOL, ASPtASPSP 

<C270i 

C 

ARE  OCTAL 

(0271 J 

C 

212,259,273,290,120290 

(0272) 

fc 

(0273) 

DATA  ANL,AC0MKA,ASCCL/138,172,187/, 

(027A) 

♦ ASP, AEPSP/160,2H  / 

(0275) 

c 

(02.76) 

DO  100  1=1,19 

(0;.'77) 

Ido 

NAHEd  )=ASPSP 

(0278' 

c 

tco 

(0279) 

N=1 

, 1 
ro 

(C2B0) 

IF(8UFF(1).KE.ASP)  GO  TO  200 

ro 

(0281) 

DO  999  1=2,77 

(0282) 

11=1-1 

(0283) 

BUFF(II)=BUFF(I) 

{C28A> 

999 

CONTINUE 

(02851 

200 

CHAR=BUFF(PEDL) 

(02861 

PLDL=PEOL*l 

(0287) 

IF(PEDL.GT.77)  RETURN 

(0288) 

IF(CHAR.EO.ANL)  GOTO  900 

(0289) 

I=(N*l)/2 

(0290) 

d=fJ-2*(N/2) 

(0291) 

N=N*1 

(0292) 

IF(J.E0.1 ) GOTO  250 

(0293) 

NAME(I)=LT(NAME(I),8)  ♦ CHAR 

(0299) 

GOTO  2CIC 

(0295‘ 

250 

NAHE(I)=  RTINAMEd)  ,8)  ♦ LS(CHAR»B) 

(02961 

GOTO  200 

(0297) 

C 

(0296' 

c 

(0299) 

AOO 

PLDL=77 

) > J 


L. 
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(CJ00> 

{03oi: 


RETURN 

END 


B-24 


SUBROUTINE  GETWO <BUFF»NAHE ) 


ACOMMA 

I 

000007 

0288S 

02731 

ANL 

I 

000008 

C288S 

02731 

0288 

ASCOL 

I 

000010 

0288S 

02731 

ASP 

I 

000011 

0286S 

02731 

0280 

ASPSP 

I 

000012 

0288S 

02731 

0277 

B JFF 

I 

ARGUMENT 

000003 

C282S 

0268S 

0280 

0283M 

cv:ar 

I 

000184 

0286S 

0285K 

0288 

0293 

GETUO 

R 

000000 

0262S 

I 

I 

000185 

C2  78M 

0277 

0281H 

0282 

C295 

II 

I 

000187 

0282M 

0283 

> 

U 

I 

000170 

D290M- 

0292 

LS 

I 

EXTERNAL 

000000 

0295 

LT 

I 

EXTERNAL 

COOOOO 

0293 

N 

I 

CC0171 

0279K 

0289 

0290 

0291H 

NAME 

I 

ARGUMENT 

C00004 

02  825 

0288S 

0277H 

QP93H 

PEOL 

I 

ttt 

000000 

02845 

C286S 

0285 

0288M 

RT 

R 

EXTERNAL 

COOOOO 

0295 

100 

000018 

0278 

0277D 

~2CC. 

000087 

0280 

0285D 

0294 

0298 

I25O 

000148 

0292 

02950 

~A0  0 

000181 

0288 

0299D 

~995 

000080 

0281 

02840 

OOCO  ERRORS  C<GETUD  >FTN-REV1 A.2 1 


\ 

) 


i 


3285 

0295 

0283  0289H  0293 


0295M 

0287 


0299F. 
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(0302) 
(0303)  C 
(030<t>  C 
(03C5J  C 
(03Cb)  C 
(0305)  C 
(0305) 
(0305) 

( C 3 D 5 ) 

(0305) 

(03C5)  ■ 

(0305) 

(0305' 

(0305? 

(0305) 

(0305) 

(0305) 

(0305) 

(0305' 

(03065 

(0307?  C 

(0308) 

(0309) 

(0310)  10 

(0511)  C 

(0312) 

(0313) 

(0314) 

(0315J 

(0316) 

(0317) 

(0310) 

(031'J) 

(0320) 

(0321) 

(03225 

(0323) 

(0324)  C 


SIJBROUTINE  SCRNHD(ITEr) 

THIS  SUBROUTINE  PERFORMS  THE  DISPLAY  ON  USER  TERMINAL  OF 
THE  APPROPRIATE  HEADER  FOR  HAIL  LOG  SEARCHES 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COHMON/E<LK/  MS , ATHH  t DD  » T 0 ,DLN » SUB  ,R OUT  » IDD  »C WA  »CONT » 

1 ADDf Tyx,FCC*NRE ,DnT,R,PTIT,COUNTtCON 

COHKON/SRC/  KfJT,DH,nA,DDD,DTO,(lL,IT,D,WA,OU,DT,DRE 
1 ♦TFVDtTLVDtFVD,LVD,IEX 

COHHON/FLA/  I TR SP , 1 MELE . I T WFX . I ANN , IPR , IH I S , I RF AO 
INTEGER  *4  A THR ( 7) ♦ T 0( 8 ) , DLN ( 5 ) * SUU ( 2 1 ) , R OUT ( 6 ) ,PT I T ( 19  ) » 

1 CON(5),TUX(6«5).FSC(f).NRE(l»3)tDDT(30*21)»T(21) 

1 *TlT(?4),r0UNT,C0NT(5),IEX(4,3) 

INTEGER»2  MS,DD(3),IDD(3)tADU(3),R,CUA(4)iUA(4)  ■ 

INTFGER*2  I TRSP 1 1 MFLE * I T WF X . I A NN , I PR , I H I S ♦ I RE  AD 
INTEGER*2  F VD ( 3 ) , LV O ( 3 ) , D ( 3) , D M * ODD ( 3 ) 

INTEGER *4  0 R E . D T ( 5 ) i DW ( 5 ) , DL ( 5 ) , D A ( 7 ) * I T ( 24 ) t OTO ( 8 ) , KNT 
DOUBLE  PRECISION  DT J , T F , TL , T JUL , TF VO, TL VO  * T I H, T J 
INTEGER*2  ITEM 
CLEAR  SCREEN  FOR  DISPLAY 
CALL  CLEAR 
URITFd  ,10) 

FORMAT (2X,7P(  ♦**)  ) 

DETERMINE  THE  ITEM  OF  SEARCH  FOR  SPECIFIC  HEADER 
IF(ITEK.EQ.l)  WRITF (1,20)DM 
IFdTEM.EQ.P)  URITE(1,30)DA 
IF(ITEM.EQ.3)  WRI TF ( 1 , 4 0 ) ODD 
IF<ITEK.EQ.4>  WRITF d,4b)OTO 
IFdTEM.EC.5)  WRITF  d ,50)DL 

IFd  TEM.E0.6)  WRITF  (1  , f 0 )((IEXd,J),J  = l,3),I=l,4> 

IF (ITEM.Ffi.P)  WRITf  (1,70)0 
IFdTEH.EQ.'')  WRITE  (1,!!0)UA 
IFdTEM.EG.lO)  WRITEd,HO)DU 
IF(ITEK.EG.ll)  WRITFd.inC) 

IF(ITEM.E0.14)  WRITF(l»12C)nRE 
IF(ITEM.E0.50)  UF  ITE(1,15) 

DISPLAY  ITEM  NAME  ANO  ENTRY  TO  HATCH 
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(0325) 

IS 

(0326i 

20 

(C327) 

30 

(0328) 

AO 

(0329J 

A5 

(0330) 

50 

(03315 

60 

(0332) 

70 

(0333) 

80 

(033A) 

90 

(0535) 

100 

(0536) 

120 

(0337) 

(0338) 

C 

(03395 

125 

(03A05 

103AK 

C 

(03A2: 

130 

(0343) 

(03AA) 

(D3A5) 

(C3A6) 

(03A7) 

(03A8) 

600 

(03A9) 

625 

(0350) 

(0351) 

(0352) 

650 

F0RMAT(2X»«**,38X«*PRINT  ALL ♦ » ?9X» » * • > 
F0RKAT(2Xt**»t3?X»*HAIL  STATUS:  • t A2 ♦28X« » * ♦) 

F0RHAT(2Xf»»»,lSX»»AUTH0R/S0URCE:  • ♦ 7A4 » 1 7X» • * • ) 

F0RHAT(2X»»»»»30X»*D0CUHFfJT  date:  * 1 2 ( I2»  • -*)  * I 2»22X,  »*•  ) 

FORMAT(2Xt»*»,20X»*U’HO  TO:  • t RA4  1 15X  , • * • ) 

FORHAT<2X,  •♦♦,2  0X,  *r'CCUHENT/LETTFR  LUHUER:  •»AAA,A2»13X»»*M 

F0R;’,AT(2X,»»*t2  0X,»''UBdLCT:  V,  4 ( 2 A A , A2  » 1 X ) »2X  . • ♦ » ) 
F0RHAT(2X,**»f3nX**INPUT  DATE:  • « 2 ( 1 2 , • -•  ) » 12  t2<iX  t • • • ) 

F0RKAT(2X»»»*»2r)X,»U.A.  NUMfsFR/ID  CODE;  * , A A2  * 2 1 X,  ♦ ♦ • ) 
F0KMAT(2X»*«*»2bX»*C0NTRACT  NU^nFR:  * , 5 AA » 1 3X , • ♦ • ) 

F0RMAT(2Xt*«*»32Xt*ACTI0N  UUE  OA TF » ♦ 29X , • • • ) 

F0RHAT(2X»**»f22X**NASA  RFSPCNSIIILF  ENGINEER:  • ♦ A3 « 23 X» ♦♦ • ) 

DISPLAY  THE  DISPLAY  FORMAT  LINE  OfJE 
WRITE(1»125) 

F0RHAT{2X»»  * SUBJEC T * t f 8 X,  ' • • ) 

DISPLAY  THE  DISPLAY  FORMAT  LINE  TWO 
WRITE(1»130)  . 

F0RMAT<2X»«*  TYPE/LETTER  NUMBER»tbX*»FILE  SYSTEM  C0DE**8X» 

1 ‘INPUT  DATE-C0DE»tl3X,»**> 

IFdTEM.EQ.ll)  WRlTEd»600) 

FORMAT<2Xd*  AUTHOR  / SOURCE  • « 8 X» ‘RESPONS  IE  LE  ENGINEER  *»4X» 
1»DUE  DATEN20X,  •»*) 

IFdTEM.EQ.ll. OR. ITEM. EQ. 50)  GOTO  650 
URITEd»625> 

FDRMAT{2X‘*  REFERENCED  DOCUMENTS*, 56x*»*») 

WRITE (1,10) 

RETURN 

END 
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-*DD 

1 

/BLK/ 

000163 

0305S 

.UHK  ■ 

J 

/PLK/ 

OOOOOI 

0305S 

CLE^R 

R 

EXTERNAL 

000000 

030P 

CON 

J 

/ELK/ 

002731 

0305S 

CONT 

J 

/ELK/ 

000151 

C305S 

COUNT 

J 

/^LK/ 

002727 

03  0 5S 

CWA 

1 

/BLK/ 

0001A5 

03C5S 

n 

u 

I 

/SRC/ 

000136 

0305  S 

0318 

DA 

J 

/SRC/ 

000003 

C305S 

0313 

DD 

I 

/DLK/ 

000017 

0305S 

ODD 

I 

/SRC/ 

000021 

0305S 

0314 

DDT 

J 

/BLK/ 

00030'! 

0305  S 

DL 

J 

/SRC/ 

OOOOAA 

0305S 

0316 

DLN 

J 

/DLK/ 

000042 

C305S 

. 

DM 

I 

/SRC/ 

0C0C02 

0305.S 

0312 

URL 

J 

/SRC/ 

000171 

0305S 

0322 

DT 

J 

/SRC/ 

000157 

0305S 

DTJ 

D 

OCOOOO 

0305S 

CTO 

J 

/SRC/ 

000024 

0305S 

0315 

DW 

J 

/SRC/ 

000145 

0305S 

0320 

FSC 

J 

/ULK/ 

000262 

0305S 

FVO 

I 

/SRC/ 

000203 

0305S 

1 

I 

001304 

0317M 

lANN 

I 

/FLA/ 

000003 

0305S 

IDD 

1 

/fcLK/ 

000142 

0305S 

lEX 

J 

/SRC/ 

000211 

0305S 

0317 

IMELE 

I 

/FLA/ 

000001 

0305S 

IMIS 

I 

/FLA/ 

000005 

0305S 

IPR 

I 

/FLA/ 

000004 

C305S 

I READ 

I 

/FLA/ 

000006 

0305S 

IT 

J 

/SRC/ 

000056 

G305S 

ITEM 

I 

ARGUMENT 

000003 

0302S 

0306S 

0312 

0313 

0314 

0315 

0316 

0317 

0318 

0319 

0320 

0321 

0322 

0323 

0344 

0347 

ITRCP 

I 

/FLA/ 

000000 

0305  S 

nVFX 

I 

/FLA/ 

000002 

0305S 

J 

I 

001305 

031  7N 

FNT 

J 

/SRC/ 

000000 

0305S 
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I 


l.VD 

1 /SRC/ 

000208 

0305S 

HS 

I /BLK/ 

000000 

0305S 

NRE 

J /ELK/ 

000276 

0305S 

TTIT 

J /ELK/ 

002661 

0305S 

R 

I /PLK/ 

002660 

0305S 

ROUT 

J /dLK/ 

000126 

0305S 

5CRKHD 

R 

000000 

0302S 

SUB 

d /ELK/ 

000054 

03  05E 

T 

J 

000005 

03  05S 

TF 

0 

000000 

0305S 

TFVD  ‘ 

0 /SRC/ 

000173 

0305S 

TIM 

D 

000000 

03  05S 

TIT 

J 

000057 

0305S 

TO 

0 

000000 

0305S 

TJUL 

0 

000000 

03D5S 

TL 

0 

000000 

0305S 

TLVO 

D /SRC/ 

000177 

0305S 

TO 

J /ELK/ 

000022 

0305S 

TtaX 

J /ELK/ 

QG0166 

0305S 

UA 

I /SRC/ 

000141 

0305S 

0319 

. 10 

000145 

0309 

03.1  OD 

_10U 

000772 

0321 

03350 

7i'20 

001016 

0322 

03360 

Il2U 

001057 

0338 

03390 

“l3C 

001 100 

0341 

03420 

15  . 

000416 

0323 

03250 

“20 

000437 

0312 

03260 

_30 

000464 

0313 

.0  32  70 

_4  0 

000513 

0314 

0328D 

~45 

000546 

0315 

03290 

Ibo 

000571 

0316 

03300 

_feO 

000626 

0317 

03310 

”f,CO 

001162 

0344 

03450 

Ib25 

001252 

0348 

03490 

£■50 

001275 

034  7 

03500 

.10 

000656 

0318 

03320 

80 

000710 

0319 

03330 

0350 
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(0353)  SUBROUTINE  SCRNPTUTEM) 

<05E4)  C THIS  SUBROUTINE  DISPLAYS  THE  DOCUMENT  FOUND  VIA 

(035S)  C SEARCH  IN  A TUO  (?)  LINE  FORMAT: 

(0o5b)  C LINE  ONE  (1)  SUBJECT 

COobT)  C LINE  TUO  (?)  DCCUMENT/LETTER  NUMBER  FILE  CODE  INPUT  DATE 

(035R.’  C 

(03BP)  C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

(0358)  C 

(0356:  COMMON/BLK/  MS  * ATHR »DD .TO ,DLN »SUB fROUT*! DD *CUA ,C0NT , 

(02t>e)  1 AOD.TUX.FSC.NRE.DDT.R.PTIT.COUNT.CCN 

(0358)  COHMQN/SRC/  KNT ,D M »DA , ODD ,D TO . DL. I T. D» UA »DW »DT .ORE 

(0356)  1 .TFVD.TLVD.FVD.LVO.IFX 

(035  8)  COMMON /FLA/  I TRSP  , IM.ELE  »I  Tk'FX  , I ANN.  IPR,  IMIS.IREAD 

(0358)  INTEGER *4  ATHR ( 7) , TO ( 8 ) , OLN (5 ) , SUH ( 2 1 ) . R OUT » 6) .PTIT(19). 

(0356)  1 CON t 5),TUX(6,5) .FSC(6) .NHE(1,3) »DOT{30»21).T{21) 

(0358)  1 .TIT (24) .C0UNT,C0NT(5) .IEX(4.3) 

(0358)  INTEGER*2  MS . DD ( 3 ) * I DD ( 3 ) . ADO ( 3 ) .R .CU A ( 4 ) , W A ( 4 ) 

(0358)  INTLGER*2  I TRSP , I HELE , ITUFX , I ANN .IPR , IH I S. I RE AD 

(0358)  INTEGER»2  F VO  ( 3 ) , L V D ( 3 ) . D ( 3. ) , DM  , ODD  ( 3 ) 

(0358)  INTEGER*4  D RE . D T( 5 > .DU ( 5 ) , DL( 5 ) , DA (7 ) . I T ( 24 ) , DTD ( 8 ) , KNT 

(0338)  DOUBLE  PRECISION  DT J .T F , TL. T JUL . TF VO . TL VDt T I Hi T J 

(0359)  INTEGER*2  ITEM 

(0360)  C DISPLAY  DOCUMENT  ON  USER  TERMINAL 

(0361)  WRITE (1,5) 

(0362)  5 FORMAT ( * •/) 

(0363)  URITE(1.10)PTIT, OLN, FSC.IDD, COUNT 

(0364)  10  F0RHAT(3X,19A4,/,3X,4A4.A2,5X,2A4,A2t»/*,2A4,A2,5X, 

(0365)  1 2(I2,*-»),I2,2X,I3/) 

(0366)  IFdTEH.EQ.ll.OR.ITEH.EQ.SO)  GOTO  650 

(0367)  IF(TUX(1,1).NE.»  •)  GOTO  175 

(0368)  WRITE(1,17?) 

(0369)  172  F0RHAT(3X, ‘NONE* ) 

(0370)  GOTO  650 

(0371)  175  WRITCd.lSO)  ((TUX(I.J),J  = 1,5),I=1»3) 

(0372)  180  F0RMAT(3X.3(4A4,A2,2X) ) 

(0373)  IF(TUX(4,1).EQ.»  »)  GOTO  650 

(0374)  URITE(1,180)((TUX(I,J),J=1.5),T=4,6) 

(0375)  C INCREMENT  FOUND  COUNTER 
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(0376) 

(0377) 

(0370 

(03795 

(03S0> 


650  Kf(T=KNT4-l 
CALL  PAUS 
CALL  RECYCL 
RETURN 
END 


U3 

< clo 
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AOO 

i 

FOLK/ 

000163 

0358S 

ATHR 

j 

/ELK/ 

000001 

035PS 

CON 

j 

/6LK/ 

002731 

0358S 

CONT 

j 

/ELK/ 

000151 

0356S 

COUNT 

j 

/ELK/ 

002727 

0358  S 

0363 

CUA 

I 

/ELK/ 

0001A5 

0356S 

. 0 

I 

/SRC/ 

0C0136 

0358S 

PA 

J 

/SRC/ 

000D03 

0358S 

OD 

I 

/ELK/ 

000017 

0358  S 

DDD 

I 

/SRC/ 

000021 

0358S 

. DOT 

J 

/ULK/ 

00030A 

0358  S 

DL 

J 

/SRC/ 

OOOOAA 

0358  S 

DLN 

J 

/CLK/ 

000042 

0358S 

0363 

CK 

I 

/SRC/ 

000002 

0358S 

ORE 

J 

/SRC/ 

000171 

0358  S 

OT. 

J 

/SRC/ 

000157 

0358S 

OTJ 

D 

000000 

0358S 

OTO 

J 

/SRC/ 

000024  ■ 

0358S 

OQ 

OU 

J 

/SRC/ 

000145 

0358S 

CO 

FSC 

J 

/RLK/ 

000262  . 

0358S 

0363 

FVD 

1 

/SRC/ 

000203 

0358S 

'i 

I 

000441 

0371M 

0374M 

I ANN 

I 

/FLA/ 

000003 

0358  E 

IDD 

I 

/ELK/ 

000142 

0356S 

0363 

lEX 

■J 

/SRC/ 

000211 

0358  S 

I^ELE 

I 

/FLA/ 

000001 

035PS 

THIS 

I 

/FLA/ 

000005 

0358  S 

IPR 

I 

/FLA/ 

000004 

0358S 

TREAD 

I 

/FLA/ 

000006 

0358S 

IT 

J 

/SRC/ 

000056 

035PS 

ITFH 

1 

arcurent 

000003 

0353S 

0359S 

ITRSP 

1 

/FLA/ 

000000 

0358S 

ITUFX 

I 

/FLA/ 

000002 

0356S 

I 

000442 

0371  M 

0374H 

KNT 

J 

/SRC/ 

000000 

0358S 

0376H 

LVO 

I 

/SRC/ 

000206 

0358S 

NS 

I 

/dLK/ 

000000 

0358S 

NRE 

J 

/BLK/ 

000276 

0358S 

I 


0366 
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PAUS 

R 

EXTERNAL 

000000 

0377 

PTIT 

J 

/BLK/ 

002661 

0358S 

0363 

R 

1 

/BLK/ 

002660 

0358S 

RECYCL 

R 

EXTERNAL 

000000 

0378 

ROUT 

J 

/PLK/ 

000126 

035PS 

SCRNPT 

R 

000000 

0353  S 

sue 

d 

/BLK/ 

000054 

0358  E 

T 

J 

000005 

0358  5 

TF 

D 

000000 

0358S 

TFVO 

0 

/SRC/ 

000173 

0358S 

TIM 

D 

000000 

0358S 

TIT 

J 

000057 

0358S 

TJ 

0 

000000 

0358S 

TJUL 

D 

COOOOC 

0358S 

TL 

0 

oooooo 

0358  S 

TLVD 

0 

/SRC/ 

000177 

0358S 

TO 

J 

/ELK/ 

000022 

03  58  S 

TWX 

d 

/ELK/ 

000166 

035PS 

0367 

0371 

0373 

UA 

1 

/SRC/ 

000141 

0358  5 

_1D 

000174 

0363 

0364D 

1T2 

000271 

C368 

03690 

175 

000301 

0367 

03710 

_U0 

000344 

0371 

03720 

0374 

i: 

000144 

0361 

03620 

Itso 

000424 

0366 

0370 

0373 

0376D 

0000  ERRORS 
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(C381) 
(0382) 
(0383) 
(038*1) 
(0385) 
(0385) 
(0385) 
(0385) 
(0385) 
(0385) 
»0385) 
(038b) 
(0385) 
(0;i65) 
(C385) 
(0385) 
(0385) 
(0385) 
(0385) 
ViCO  (0385) 
(03,86) 
(0387) 
(0388) 
(0389) 
(0390) 
(0391) 
(0392) 
(0393) 
(039*n 
(0395) 
(0396) 
(0397) 
(0398) 
(0399) 
(09005 
(09015 
(0902) 
(0903) 


SUBROUTINE  HARDHD(ITER) 

C THIS  SUBROUTINE  PERFORMS  THE  WRITING  TO  TEMPORARY  FILE  (7)  . 

C OF  THE  APPROPRIATE  HEADING  FOR  HAIL  LOG  SEARCHES  TO  BE 

C SPOOLED  TO  THE  PRINTER  FOR  OUTPUT  IF  DFSIREO 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

COKMON/BLK/  HStATHP*DD*TO»DLN»SUl)tROUTtIDOtCUA»CONT» 

1 ADD,  TUXtFSCtNRF  * DOT  tP.»PT  IT.  COUNT*  CON 

COMMON /SRC/  KNT.DM.UA.DDO.DTO.OL.IT.D.UA.DW.DT  .DRE 
■ 1 .TFVD.TLVD.FVO.LVD.IEX 

COMHON/FL A/  I TR SP . I MELE . I T WFX  . I ANN  . IPR  . I HI S . 1 RE AD 
INTEGER*9  ATHR(7).T0(8)»DLN(5)»SUB(21).R0UT(6)»PTIT(19)» 

X CON(5 ) . TUX (6 .5 ) .FGC( 8 ) . NRF( 1 .3) .DDK  30 .21 ) »T ( 21) 

1 ,T1T(29) .COUNT.CONT(b)  .IEX(9.3) 

INTEGER*2  MS.DD(3).1DD(3).ADD(3).R.CWA(9).VA(9) 

INTEGER *2  I TRSP .1 MF LE . I TWFX . 1 ANN . IPR . I H I S. I RE  AO 
INTEGER <2  FVD(3).LVD(3).D(3).DM.DDD(3) 

INTEGER*9  Df'E  . DT  ( 5 ) » DU  ( 5 ) . DL  ( 5 ) . D A ( 7 ) . 1 T (29  ) . DTO  ( 8 ) . KNT 
DOUBLE  PRECISION  DT  J .T  F . TL.  T JUL  .TF  VO.  TL  VD.  T I tl . T J 
INTEGER‘2  I TEM  . ARR A Y ( 1 E ) 

C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

CALL  TIMDAKARRAY.i;.) 

AH1N=ARRAY(9) 

AH=AMIN/60.0 
IH  = AH 
IMH=IH*60 
IMIN=AHIN 
IDH=IHIN-1MH 

URITE(7.1000)IH.IOH.(ARRAY(I). 1=1.3) 

1000  FORMAT(‘1’.100X.I3.»:*»I3«9X«2(A2.»/*).A2) 

WRITE(7.700) 

C DFTERMINE  THE  ITEM  OF  SEARCH  FOR  SPECFIC  HEADER 

IF  (ITEM. EO. 50)  WRITE(7.15) 

IF( ITEM.EO.l ) WKITE(7.20)DH 
IF  (ITEM. EG. 2)  URI TE (7.30 ) DA 
IF(ITEK.EC.3)'  UPITF(7.90)DDD 
IF(ITEM,.EQ.9)  UR  I Tt  ( 7 . 95  ) DT  0 
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(OAOA) 

(0A05) 

(0A06)  ■ 

(DA07) 

(OAOft) 

(CA09) 

(OAIO) 

(OAll) 

C 

(0A12) 

15 

(0A13) 

20 

(QAIA) 

30 

( Oh15) 

AO 

(0A16) 

A5 

(CA17) 

50 

(DAIS) 

60 

(0A19) 

70 

(0A2C) 

&0 

(0A21) 

90 

(0A22) 

100 

(0A23) 

120 

( 0 A 2 A ) 
(0A25) 

C 

(CA26) 

(DA27) 

130 

(0A28) 

(CA29' 
(0*30) 
(0A31  > 
(0A32) 

500 

(0A33) 

600 

(0A3A  ) 

650 

(0a35) 
(0A365 
( 0 A 3 7 5 

700 

IFdTEH.EQ.b)  WR IT E ( 7 1 50  ) OL 

IF(  ITEH.EO.f.)  WRITE  (7*60)  ((IEX(ItJ)tJ  = l»3)»I=l»A) 

IF ( ITEH.EQ.8)  WRITL(7,70)0 
IF (ITER. to. 9)  URITE(7tR0)UA 
IFdTER.EO.lO)  WRnr(7,90)DW 
IFdTER.EQ.il>  URITE(7,100) 

IFdTEH.EO.l'l)  WRITF(7,120)DRE 
WRITE  ITEM  NARE  AND  ENTRY  OF  HATCH 
FORRAT (70X. 'PRINT  ALL*) 

F0RHAT(F2X, ’RAIL  ST ATUS : • , A X, A2 ) 

F0RMAT(52X,  • AU THOR / SOUP CF ! *,AXt7A4> 

FORHAT(60X, 'OOCUHEN'T  D A T E : • , A Xt  2 (1 2 * •- ♦ ) , 12) 

FORRAT  (F.OXt  •WHO  T0:*,AX,8AA) 

FOR  HAT  (SOX, 'DOCUMENT /UTTER  NUMBER  :♦  ,AX  ,AAA  ,A2  ) 
FORHAT(50X,'SUBJECT:*,3X,A(1X,2AA,A2)) 

FORRAKtOX, 'INPUT  D A TE  t • , A X , 2 ( 1 2 , * - • ) , 1 2 ) 

FORMAT  (55X, 'W'.  A.  NUMBER/ID  CODE  : • , A X,  A A2) 

FORMAT (55X, 'CONTRACT  NU MB ER : ♦ , A X, 5 AA ) 

F0RMAT(62X, 'ACTION  I'UE  DATE') 

F0RMAT(52X, 'NASA  RESPONSIBLE  ENGI NE ER I ♦ , AX , A3 ) 

WRITE  PRINT  FORMAT  LINE  ONE  HEADER 
WRITE(7,13C) 

FORMAKE'X, 'SUBJECT' ,69X, 'TYPE/LETTER  NUMBER  FILE  SYSTEM  CODE', 
1 6X , 'DATE-CODE' ) 

IF(ITEM.EG.ll)  WRITE(7,500> 

F0HMAT(5X , 'AUTHOR  / SOUR CE ', 61 X ,' R FSPONS IDLE  ENGINEER', 

1 22X, 'PATE-DUE' ) 

IF  ( ITEM.EQ .11 .OR. ITEM.E0.50 ) GOTO  650 
WkITL(7,(.nO) 

F0RMAT(5X, 'REFERENCED  DOCUMENTS') 

WRITE(7,700) 

FCRMAT(5X,127(  •")  ) 

RETURN 

END 


SUUROUTINt  HARDHO(ITEH) 
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ADO  I /tJLK/  000163  0385$ 

AH  R 001257  039CK  0391 

AKIN  R 001261  0389K  0390  0393 

ARRAY  1 000005  038£S  0388A  0389 

ATHR  J /L’LK/  000001  03S5S 

CON  J /BLK/  002731  0385S 

CONT  0 /DLK/  000151  0385$ 

COUNT  J /ELK/  002727  0385S 

CUA  I /ELK/  0Q0M5  C3R5S 

0 I /SRC/  000136  C385S  0406 

■ DA  J /SRC/  C00003  0365S  0401 

OD  I /fLK/  000017  0385$ 

DDD  I /SRC/  000021  0385$  0402 

DDT  J /ELK/  000304  0385$ 

CL  J /£RC/  000044  0385$  0404 

DLH  J /ELK/  000042  0385$ 

OK  I /SRC/  000002  0385$  0400 

ORE  J 0001  71  0385$  0410 

pj  DT  J /SRC/  00C157  0385$ 

-Cr  1 DTJ  0 000000  0385$ 

■\j\^  DTO  J /SRC/  000024  0385S  0403 

DU  J /SRC/  000145  0385$  0408 

I FSC  J /ELK/  000262  03655 


FVD 

1 

/SRC/ 

000203 

0385$ 

HARDHD 

R 

000000 

C381S 

I 

I 

001263 

0395K 

0405H 

lANN 

I 

/FLA/ 

000003 

0385$ 

lOD 

I 

/ELK/ 

000142 

0385S 

IDK 

I 

001264 

0394K 

0395 

lEX 

J 

/SRC/ 

000211 

0385$ 

0405 

IH 

I 

001265 

0391K 

0392 

IMELE 

I 

/FLA/ 

000001 

0385$ 

IKIN 

I 

0012^6 

0393K 

0394 

IKIS 

I 

/FLA/ 

000005 

0385$ 

IKK 

I 

001267 

0392K 

0394 

IFR 

I 

/FLA/ 

000004 

0385$ 

IREAD 

I 

/FLA/ 

000006 

0385$ 

IT 

J 

/SRC/ 

000056 

0385  S 

0395 
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SUBROUTINE  HARDHD(ITEM) 


ITEH 

I 

ARGUMENT 

000003 

0381S 

0386S 

0404 

0405 

0428 

0431 

ITPSP 

I 

/FLA/ 

000000 

0385S 

ITUFX 

I 

/FLA/ 

00000? 

03  85S 

d 

I 

001270 

04  OEM 

KNT 

J 

/SRC/ 

000000 

038  5 S 

l.VD 

I 

/SRC/ 

000206 

0385S 

MS 

I 

/LLK/ 

000000 

0385F 

NRE 

J 

/BLK/ 

000276 

03  85S 

PTIT 

■ J 

/r-LK/ 

002661 

0385S 

R 

I 

/r-LK/ 

002660 

C385S 

ROUT 

d 

/FLK/ 

000126 

038  5 S 

SUB 

d 

/BLK/ 

COOOSA 

0385S 

1 

d 

00002A 

0385S 

Ir 

D 

000000 

0385S 

TFVt; 

0 

/SRC/ 

000173 

0385  S 

TIM 

0 

000000 

0385S 

T I MOAT 

R 

EXTERNAL 

000000 

0388 

TTT 

d 

000076 

03P.5S 

TJ 

n 

000000 

03858 

TdUL 

0 

000000 

03R5S 

TL 

n 

000000 

0385S 

TL  VO 

D 

/SRC/ 

000177 

0385S 

TO 

d 

/ELK/ 

00002? 

0385S 

TyX 

d 

/BLK/ 

000166 

0385  S 

UA 

I 

/SRC/ 

000141 

0385S 

0407 

_10  0 

001006 

0409 

04220 

_1000 

000245 

0395 

03960 

_120 

001 023 

0410 

04230 

_13C 

001055 

0425 

04260 

000540 

0399 

04120 

_20 

000552 

0400 

04130 

_3  0 

000570 

0401 

04140 

'tO 

000610 

0402 

04150 

I'*  5 

C00634 

04  0 3 

04160 

_50 

000650 

0404 

04170 
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SUBROUTINE  HARDHDdTEM) 


500 

00113* 

0926 

09290 

3&0 

000676 

0905 

09180 

~600 

001220 

0932 

09330 

~S50 

001237 

0931 

09390 

70 

000717 

0906 

09190 

_70C 

0012A3 

0397 

0939 

~80 

0007A2 

0907 

09200 

90 

000765 

09  0 8 

09210 
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(DA38) 

( 0A39) 

f OAAO) 

(C441)  . 

(0AA2) 

(C';42> 

(0A<t2) 

(0'.A2) 

( O'!  A2 ) 
(0AA2) 
(0‘lA2) 
(C'lAD 
(QAA2) 
(0A<f2) 

(0AA2) 

<0A'i2> 

(0'4«t2) 

(04A2) 

(0AA3) 

(OflA't) 

(O't'tB) 

(G^tAb) 

(0AA7) 

<0AA8> 

(0AA9> 

1 0 A 5 0 > 
(0A51) 
(CAb2) 

( 0 A b 3 > 
(OAbA) 
(0A55) 
tOAbb) 


SUBROUTINE  HARDPT(ITEH) 

C THIS  SUBROUTINE  PERFORMS  THE  WRITE  TO  TEMPORARY  FILE  (7) 

C FOR  OUTPUT  IF  DESIRED  OF  A ONE  (1)  LINE  FORMAT: 

C SUBJECT  TYPE/LETTER  NUMBER  FILE  CODE  DATE 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

C 

COHMON/BLK/  HS»  ATHR»DOi TO.OLN*  SUB»RCUT» IDD«CWA  ,CONT. 

1 AOD*TWX,FSCtNRE»DnT,R,PTIT»COUNT»CON 

COHKON/SRC/  KNTtDH,DAt!:iOD«DT0tI)L»IT,0»UA»DUtDTfDRE 
1 .TFVD»TLVD,FVn*LVD»IEX 

COMHON/FLA/  ITRSP.irELL,ITU'FX,TANN,lPR«IHIS*IREAD 
INTEGER'A  ATHR(7),T0(P)iDLN<5).rUB(21>«R0UT(b),PTIT<19), 

1 CON{b>,TUX(t,b)  ,FSC(t.),  NR  L (1,3)  *0BT(  30,21  >,T(21) 

1 ,T IT(2A) ,COUNT, CONT(b) ,irX( A ,3) 

INTEGER*2  MS,DD(3)  ,I0Dt3).,AnD(3),n,CWA(A)  ,l.iA<A) 

1NTEGER*2  ITRSP,IHLLE,ITWFX,IANN,1PR,IHIS,IREAD 
INTEGER*2  E VD ( 3 > , L VP ( 3 ) , D ( 3 ) , DM ,DD0 ( 3 ) 

INTEGER*A  0RE,DT ( 5) ,DU( 5) ,DL(5) ,DA(7) , IT(2A) ,DTO(fi) ,KNT 
DOUBLE  PRECISION  DT J , T F , T L, T JUL , T F VD , TLVD , T I H, T J 
INTEGER*2  ITEM 

C WRITE  COUNTER  AND  DOCUMENT  RECORDS  ON  TEMPORARY  FILE  7 

WRITE(7,1C) KNT,PTIT,nLN,FSC,IDO,COUNT 
10  FORHAT(*0',IA,’.*,19AA,AAA,A2,1X,2AA,A2,*/*,2AA,A2, IX, 312,13) 

IFdTEM.EC.ll.OR.lTEM.EQ.EO)  (3CTO  bbO 
IFdWXn,  1).NE.»  •)  GOTO  17b 

WRITE(7,172) 

172  F0KHAT(6X,*N0NF*) 

GO  TO  190 

175  WRITr(7,i80) { (TUX( I, J) , J=1 ,5) , 1=1,6) 

180  F0RHAT{AX,t<2X,AAA,A2>) 

190  CONTINUE 
650  RETURN 
END 


SUBROUTINE  HAROPTdTEH) 


ADD  1 /BLK/  000163  0AA2S 

ATHn  J /BLK/  000001  0442S 

CON  J /BLK/  002731  0^A2S 

CONT  d /RLK/  000151  0AA2S 

COUNT  J /BLK/  002727  0AA2S  0AA5 

CWA  I /BLK/  0001^(5  0442S 

D I /SRC/  000136  C'l'tBS 

DA  J /SkC/  CC0003  CAA2S 

DD  I /BLK/  C00017  OAAPS 

ODD  I /SRC/  000021  OAAPS 

DDT  'j  /BLK/  00030A  CAA2S 

DL  J /SRC/  OOOOAA  CAA2S 

DLN  J /BLK/  OOOOA2  0AA2S  0AA5 

DM  I /SRC/  000002  0A42S 

DRE  J /SRC/  000171  04A2S 

DT  J /SRC/  000157  0AA2S 

DTJ  0 000000  0AA2S 

DTO  J /SRC/  00002A  0AA2S 

^CO  DU  J /SRC/  000145  0442S 

FSC  J /BLK/  000262  0442R  0445 

""'O  FVD  . I /SRC/  000203  . 0442S 

HARDPT  R COOOOO  043HS 

I I C00344  C452K 

lANN  I /FLA/  000003  0442S 

IDD  I /F’LK/  000142  0442S  0445 

UX  J /SRC/  000211  0442S 

IMELE  I /FLA/  000001  0442S 

IKIS  1 /FLA/  000005  0442S 

IPR  1 /FLA/  00000'<  0442S 

IREAD  1 /FLA/  000006  C442S 

IT  J /SRC/  000056  0442S 

ITEf:  I ARGUMENT  000003  043flS  0443S  0447 

ITRSP  I /FLA/  OOOOCC  0442S 

ITUFX  I /FLA/  000002  0442S 

J I 000345  0452M 

KNT  J /SRC/  000000  0442S  0445 

LVU  I /SRC/  000206  0442S 

HS  1 /BLK/  000000  0442S 
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NRE 

U /BLK/ 

000276 

0AA2S 

PTIT 

J /ELK/ 

002661 

0A42S 

0445 

R 

I /ELK/ 

002660 

0442S 

ROUT 

J /ILK/ 

000126 

0442S 

SUB 

J /ELK/ 

00005A 

0442S 

T 

J 

000005 

04  425 

TF 

D 

000000 

04425 

TFVO 

D /SRC/ 

OCO 173 

0442S 

TIH 

D 

ncooo  0 

04  42S 

TIT 

J 

000057 

0442S 

TJ 

D 

rooooo 

0442S 

TJUi. 

D 

000000 

0442S 

iL 

0 

CGOOOO 

04425 

TL  VO 

D /SRC/ 

000177 

04425 

TO 

J /ELK/ 

000022 

0442S 

TUX 

J /ELK/ 

000166 

0442S 

0448 

UA 

1 /SRC/ 

000  lA  1 

C442S 

10 

000166 

0445 

0446D 

”l72 

000256 

0449 

G450D 

-.175 

000266 

044S 

04520 

ISO 

000330 

0452 

0453D 

live. 

Q003A2 

0451 

0454D 

_650 

0003A2 

0447 

04550 
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€0457) 

(0458) 

€0459) 

(04G0) 

<C-460) 

<0  4(x0) 

(0460) 

(0460) 

(0460) 

(0460) 

(0460) 

(0460) 

(0460) 

(0460 

(0460) 

(0460) 

(0460) 

(0460) 

(0460) 

(0461) 

(0462) 

(0463) 

(0464) 

(0465) 

(0466) 

(0467) 

(0468) 

(0469) 

(0470) 

(0471)- 

(0472) 

(0473) 

(0474) 

(0475) 

(0476) 

(0477) 

(0478) 

(0479) 


SUBROUTINE  BRAKE! 

C THIS  SUBROUTINE  PERFORMS  THE  DEFINING  OF  THE  TIME 

C FRAME  TO  E,E  SEARCHED  DURING  THE  SEARCH  MODE*  IF  DESIRED 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

COMMON/BLK/  MS, ATHR ,00 , TO *OLN ♦ SUB , ROUT . I DO « CUA ,CONT, 

1 ADC, TUX»FSC,NRE,ODT,R  ,PTIT,COUNT,CON 

COMMON/SRC/  KNT,DM,DA,L'DD,DTO,OL,IT,D,UA,OW,DT,DRE 
1 ,TFVO,TLVD,FVD,LVD,IEX 

COMMON/FLA/  I TRSP , 1 MELF , I TUFX , 1 ANN , IPR , I HI S , I R E AD 
INTEGER*4  A THR ( 7) , TO ( 8 ) , DLN ( 5 ) , SUB ( 2 1 ) , ROUT ( 6) ,P T I T ( 19 ) , 

1 C0f'(5),TWX(6,5),FSC(6),NRE(l,3),DDT(30,21),T(21) 

1 ,TIT(24) ,C0UNT,C0NT(5),IEX(4,3) 

INTEGER*2  MS , UD (3 ) , I CD ( 3 ) , ADD ( 3 ) , R , CU A ( 4 ) , UA ( 4 ) 

INTEGER*2  I TRSF , I ME L E, I TWF X , I A NN  , I PR , IM I S , I R E AO 
INTFGER»2  F VD  ( 3 ) , L VT.' ( 3 ) , C ( 3)  , CM  , ODD  ( 3 ) 

INTt‘GER*4  DRE,DT(5)  ,0U(5)  ,DL(5)  ,DA(7)  , IT(24)  ,DTD(8)  ,KNT 
DOUBLE  PRECISION  DT U, TF , T L , T JUL, TF VC , TLVD, T I M, TJ 
C DETERMINE  THE  FIRST  DATE 

880  WRITE(1,881) 

881  FORHAK’  WHAT  IS  THE  FIRST  VALID  D A TE  • , / , • MHDO  YY  • ) 
READ(1,882,FRR=P80)FVD 

882  F0RMAT(3I2) 

C CHECK  FOR  VALID  DATE  ENTRY 

IF (FVD(l) .GT .12.CR.FVO(2) .GT.31  ) GOTO  880 
C STORE  LEGAL  ENTRY  BY  MONTH,  DAY,  YEAR 

IMrFVD(l) 

ID=FVD(2) 

I Y=FVD(3) 

C CONVERT  THE  FIRST  DATE  TO  JULIAN  TIME 

CALL  JTIMF(IY,IM,ID,0,0,0,TJ) 

C STORE  JULIAN  (FIRST)  TIME 

TFVDrTJ 

C DETERMINE  THE  LAST  DATE  OF  TIME  FRAME 

885  URITE(1,884) 

884  FORMAT!’  WHAT  IS  THE  LAST  VALID  DATE • ,/, ’MMDDYY* ) 

READ ( 1,882, ERR=86 5 ) LVD 


L 
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(0A80) 

C 

CHECK  FOR  VALID  ENTRY 

(OA81) 

IF(LVD(1) .GT.12.0R.LVD(2).G7.31)  GOTO  885 

( 0 A 8 2 ' 

C 

IF  NO  LAST  ENTRY  SPECIFIED,  SET  TO  MAXIMUM  DATE 

(0A83> 

C 

DEC.  31,  1999 

(0A8A  > 

IF(LVO(1).EO.O)  LVD(1)=12 

(CA8b> 

IF (LVD<2) .EO.O)  LVD(P)-31 

(0A8' ) 

IF(LV0(3).EC.C)  LVD(3>=99 

(0A87> 

c 

STORE  LAST  DATE  BY  MONTH,  DAY,  YEAR 

(C-iyC  ' 

IM=LVO(l ) 

< C A 8 9 > 

ID=LV0(2) 

(OA9C) 

IY=LVC(3) 

(0A91> 

c 

CONVERT  THE  LAST  DATE  TO  JULIAN  TIME 

<0A92)  , 

CALL  JTIHE(IY,IM,IO,O,0,0,TJ) 

(OA93) 

c 

STOKE  JULIAN  (LAST)  TIME 

(0A5A) 

TLVD=TJ 

(0A95) 

c 

ARE  THE  DATES  ENTERED  COMPATIBLE,  YES  RETURN 

(OAOfc) 

c 

ELSE  DISPLAY  ERROR  MESSAGE 

(0A97! 

IF(TLVO.GE.TFVD)  GO  TO  888 

( C A 9 8 1 

URITE(1,887) 

(OA59- 

887 

FOKMAT(»  GGLRROR  IN  DATES  - PLEASE  TRY  AGAIN*/) 

(C50C  i 

GO  TO  880 

(0501  ) 

886 

CONTINUE 

(0b02> 

RETURN 

{0E03) 

END 
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ADD 

I 

/BLK/ 

000163 

AThR 

U 

/ELK/ 

000001 

BRAKET 

R 

000000 

CON 

J 

/BLK/ 

002731 

CONT 

J 

/BLK/ 

000151 

COUNT 

J 

/PLK/ 

002727 

CUA 

I 

/BLK/ 

000145 

D 

I 

/SRC/ 

000136 

DA 

J 

/SRC/ 

000003 

DO 

I 

/BLK/ 

000017 

COD 

I 

/SRC/ 

000021 

DDT 

J 

/PLK/ 

000304 

DL 

J 

/SRC/ 

000044 

DLN 

J 

/BLK/ 

0C0042 

DM 

•I 

/SRC/ 

000002 

ORE 

tl 

/SRC/ 

000171 

DT 

J 

/SRC/ 

000157 

DTJ 

D 

000000 

OTO 

J 

/SRC/ 

000024 

UU 

J 

/SRC/ 

000145 

f SC 

J 

/BLK/ 

000262 

KVD 

I 

/SRC/ 

000203 

lANN 

I 

/FLA/ 

000003 

ID 

I 

000442 

lOD 

•I 

/PLK/ 

000142 

lEX 

J 

/SRC/ 

000211 

IH. 

I 

000443 

IHE.LE 

I 

/FLA/ 

000001 

INIS 

I 

/FLA/ 

000005 

IPR 

I 

/FLA/ 

000004 

IREAD 

I 

/FLA/ 

OCOOOb 

IT 

J 

/SRC/ 

000056 

ITRSP 

I 

/FLA/ 

000000 

ITWFX 

I 

/FLA/ 

000002 

lY 

I 

000444 

•JTIHE 

I 

EXTERNAL 

000000 

KNT 

J 

/SRC/ 

000000 

I.VD 

I 

/SRC/ 

000206 

CA60S 
0A60S 
0457S 
0A6P  S 
0A60S 
CAf  CS 
046QS 
0460S 
OAtOS 
04ACS 
C460S 
P46CS 
CAACb 
C460S 
04  6 0S 
046QS 
046CS 
C460S 
046CS 
C46CS 
04  6CS 


0460S 

0464H 

0467 

0469 

0470 

0460S 

C470M 

0473A 

0489H 

0492A 

04  60  S 
0460S 
0469M 

0473  A 

04SRH 

0492A 

046DS 
C460S 
0460S 
046CS 
0460S 
0460S 
04  60S 
Ci471M 

0473A 

0490H 

0492A 

• 

0473 

0460S 

046DS 

0492 

0479H 

0481 

0484N' 

0485H 
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CAB9 

0A90 

MS 

1 

/&LK/ 

000000 

0A60S 

NRE 

J 

/ELK/ 

000278 

0A60S 

PTIT 

J 

/ELK/ 

002881 

0A80S 

R 

I 

/ELK/ 

002880 

0A6CS 

ROUT 

J 

/ELK/ 

000126 

OA60S 

SUB 

J 

/ELK/ 

00005A 

0A60S 

r 

J 

C00002 

CA80S 

IF 

0 

000000 

CA60S 

TFVO 

D 

/SRC/ 

000173 

0A60S 

0A7bH 

0A97 

rid 

0 

000000 

0A60  S 

TIT 

J 

00005A 

0A60S 

TJ 

D 

000AA6 

0A60S 

0A73A 

0 A75 

0492A  OA9A 

TJUL 

D 

000000 

0A60  S 

• 

TL 

D 

000000 

0A80S 

7LV0 

D 

/SRC/ 

000177 

CA80S 

0A9AH 

0A97 

TO 

J 

/ELK/ 

000022 

0A8OS 

TUX 

J 

/ELK/ 

000188 

0A8C.S 

UA 

I 

/SRC/ 

000  lA  1 

0A80  S 

_880 

00013A 

0A82D 

0A6A 

0A67 

0500 

~881 

COOlAl 

0A82 

0A63D 

_882 

000201 

0A6A 

0A65D 

0 A79 

000260 

0A77 

0A78D 

_885 

00025A 

0A77D 

. OA79 

OA81 

_88b 

OOOAAO 

0A97 

0501D 
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(0504)  C 
(0505) 
(0506)  C 
(05.07)  C 
(0508)  C 
(0507)  C 
(0509)  C 
(0509)  C 
(0509) 
(0509) 
(0509) 
(0509) 
(0509) 
(0509) 
(C5C9) 
(0509) 
(0509.) 
(0509) 
(0509) 
(0509) 
(0509) 
(0510)  C 
(0511)  C 
(0512)  C 
(0513)  C 
(0514) 
(0515)  51 

(0515) 
(0517) 
(0518)  C 
(0519)  C 
(0520)  C 
(0521)  C 
(0522)  100 

(0523)  101 

(0524) 
(0525) 
(0526)  C 


SUBROUTINE  RDSUB 

THIS  SUBROUTINE  PERFORMS  A READ  FUNCTION  FOR  SELECTED 
SUB-FILES  DURING  SEARCH  SUBROUTINES 


DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

COMMON /BLK/  MS, ATHR . DD» TO ,OLN , SUB » R OUT t I DDt C WA ,CONT» 

1 AOD,TUX,FSC,NRr , DDT, R,PT IT, COUNT, CON 

COMHON/SRC/  KNT,DM,DA,nOD,l)TO,nL,IT,D,UA,DU,DT,DRE 
1 ,TFVD,TLVD,FVO,LVn,IEX 

COMHON/FL A/  I T RSP , 1 MELE , I TWFX , I ANN , IPR , IH I S , 1 RE AD 
I NT  EGER *4  ATHR(7),TO(P>,OLN(5),SUB(21),ROUT(6),PTIT(19), 

1 CCN(5),TUX(6,5) ,FEC(f.) ,NRF( 1,3 ),0DT( 30,21 ),T (21) 

1 , TIT (24) ,C0UNT,C0NT(5),IEX(4,3) 

INTEGER *2  HS,DD(3),lDDt3),ADD(3),K,CUA(4),WA(4) 

INTEGER  *2  ITRSP,IMELE,nyFX,IANN,IPR,IMIS,IREAD 
INTEGER*2  F VD  ( 3 ) , LV  0(  3 ) , D ( 3)  , O'' , UDD  ( 3) 

INTEGER *4  DRE,DT(5>,DW(5),DL(S),DA(7),IT(24),DT0(8),KNT 
DOUBLE  PRECISION  DT J , TF , T L, T JUL, TFVD , TLVO, T I H,  T J 

IS  THIS  A TRANSMITTAL/SPF.CIFICATION  SUBFILE  READ  REQUEST 
YES,  PERFORM  READ 

IF(ITRSP.EQ.O)  GOTO  100 

REAO<6,END=100)MS,ATHR,DD,TO,DLN,SUB,PTIT,ROUT,IOD,COUNT» 

1 CWA,CONT,ADD,TU’X»FSC,NRE,DOT 

RETURN 

IS  THIS  A MEMO/LFTTFR  SUBFILE  READ  REQUEST 
YES,  PERFORM  READ 

IF(IMELE.EG.O)  GOTO  200 

REAO(11,END=200)MS,,ATHR,OD,TO,OLN,SUB,PTIT,ROUT,IDD,COUNT, 
1 CUA,CONT,ADD,TU'X,FSC,NRE 

RETURN  . 
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C 


(0527J  C 
(C528>  C 
(0529)  C 
(0530)  200 

(0531)  201 

(0532) 
(0533) 
(0534)  C 
(0535)  C 
(0536.'  C 
(0537)  C 
(053fl)  300 

(0539)  301 

(0540) 
(0541) 
(0542)  C 
(0543)  C 
(0544)  C 
□3  (0545)  r 

I (0546)  400 

(0547)  401 

(0548) 
(0549) 
(0550)  C 
(0551)  C 
(0552)  C 
(0553)  C 
(0554)  500 

(0555)  501 

(0556) 
(0557) 
(0558)  C 
(0559)  C 
(0560)  C 
(0561)  600 

(0562) 
(0563) 


IS  THIS  A TUX/HAGNAFAX/RAPIFAX  SUBFILE  READ  REQUEST 
YESt  PERFORM  READ 

IF(ITWFX.EQ.O)  GOTO  300 

READ(12»END=300>HS» ATHR»DDtTO,DLN,SUB»PTIT.ROUTt IDD. COUNT* 
1 CWA,CONT,  ADD*TUX*FSC*rjRE 

RETURN 

IS  THIS  AN  ANNOUNCEMENT  SUBFILE  READ  REQUEST 
YES*  PERFORM  READ 

IF(IANN.EQ.O)  GOTO  400 

READ(13*END  = 40  0 )MS.  ATHk,DD*TO.|iLN*SUB»PTIT*ROUT«IDO,COUNT» 
1 CWA,CONT,ADD*TWX,FSC,NRE 

RETURN 

IS  THIS  A PURCHASE  REQUEST  SUBFILE  READ  REQUEST 
YES*  PERFORM  READ 

IF(IPR.EO.O)  GOTO  500 

READ(14.END  = 5D0)MS,  ATHR*DD*TO*nLN,SUB»PTlT»ROUT,IDD*COUNT* 
1 Cl'A,CONT*ADD*TWX,FSC*NRE 

RETURN 

IS  THIS  A MISCELLANEOUS  SUBFILE  REAt)  REQUEST 
YES*  PERFORM  READ 

IF(IMIS.EQ.O)  GOTO  600 

READ(15,END=6J0)MS, ATHR*  DO . TO  * DLN ♦ SUB *PTIT *ROUT * I DD * COUNT  * 
1 CUA  *CONT, ADD*  TUX*FSC*NRE 

RETURN 

FINISHED  ALL  SUBFILES 

IREAD=1 

RETURN 

END 
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ROUT 
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_2  01 
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3 0 0 
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0530 

0531 

_301 

000929 

0539C 

3<jO 
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SiUEROUTINE  RESEA 


(056A)  SUdROUTINE  RESEA 

(05G5)  C THIS  SUBROUTINE  PERFORMS  THE  NASA  RFSPONSIELE  ENGINEER 

(0S66)  C SEARCH  AND  FORMATS  THE  FINDINGS  FOR  OUTPUT 

C0567)  C 

<0b67)  C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

(0567)  C 

(0b67)  COHHON/BLK/  MS , ATHR ,DD »T0 ,DLN * SUB »R0UT t IDD »CUA tCONT » 

(0567)  1 AOD*TWX,FSC*NRE»DDT»R»PTIT»COUNT»CON 

(0567)  COHHON/SRC/  KNT «DM * DA  * DDD rDTO, DL , I T » D» U A , DU , DT »DRE 

(0567)  1 ,TFVDiTLVD«FVD*LVDiIEX 

(0567)  CDMMON/FLA/  I T R SP  ♦ I MF.LF  . I TUFX  , I ANN  t IPR  * I M IS  1 1 R E AD 

(0567)  I NT EGER* A A THR ( 7) * T 0( 8 ) « DLN( 5 ) , SUB ( 2 1 ) » R OUT (6)»PTIT(19)* 

(0567)  1 C0N(b).TUX(6.5) fFSC(6) ♦NRF(1»3) »DDT( 30»21 ) »T(21) 

(0567)  1 ,TIT(2A), COUNT, C0NT(5)tIEX(4,3) 

(0567)  INTEGER*2  MS , DD ( 3 ) , I DD (3 ) , ADD ( 3 ) , R , CU A ( A ) , UA ( A ) 

(0567)  INTF,GER*2  I T KSP  , I HE  LE  « I TWFX  , I ANN  , I PR , I H I S,  I READ 

(0567)  INTEGER*2  F VO ( 3 ) , LV D ( 3 ) , D ( 3 ) , DM ,DDD ( 3) 

(0567)  INTEGER *A  DPE,DTr5),DU(5)»DL(5)»DA(7),IT(2A>,DTO(0)»KNT 

(0567)  DOUBLE  PRECISION  DT  J , TF  , TL  , TJUL  , TF  Vf),  TLVD,  TI  M,  T J 

(0568)  INTEGER*2  I P AGE , I PR INT , I T EH 

(056S)  C INITIALIZE  COUNTER 

(0570)  KNT=0 

(0571)  C INITIALIZE  TOP  OF  PRINTER  PAGE  FLAG 

(0572)  IPRINT=0 

(0573)  C INITIALIZE  FIRST  FOUND  FLAG 

(057A)  IPAGE=0 

(G575)  3 URITE(1»1) 

(0576)  1 FORMAT!*  RESPONSIBLE  ENGINEER  SEARCH*,/, 

(0577)  1 * UHO  IS  THE  NASA  RESPONSIBLE  ENGINEER  (INITIALS  ONLY)*/) 

(0576)  READ(1,2,ERR=3)DRE 

(0579)  2 F0RHAT(A3) 

(0580)  C READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE. 

(0581)  100  CALL  RDSUB 

(05P?)  C IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 

(0563)  IFdREAD.EC.l ) GOTO  200 

(056A)  IH=IDD(1) 

(0585)  ID=10D(2) 

(0566)  IY=ID0(3) 


,) 


■C  2 


(0587)  CALL  JTI ME ( I Y» 1 H» I D » 0 t Q t 0 » TIH) 

(0588)  IF(TFVD.LE.TIM.AND.TIH.LE.TLVD)  GO  TO  890 

(0589)  GO  TO  ICO 

(0590)  890  CONTINUE 

(0591)  DO  11  d=l»3 

(0592)  IF (PRE.EQ*NRE(1,J))  GO  TO  150 

(0593)  11  CONTINUE 

(0599)  GO  TO  100 

(0595)  C ENGINEER  FOUND 

(C596)  C IS  THIS  THF  FIRST  ENGINEER  FOUND 

(0597)  150  IF ( IPAGE.NE .0)  GOTO  100 

(0598)  C SET  FOR  FIRST  ENGINEFR  DISPLAY 

(0599)  IPAGE=1 

(0600)  ITEH=19 

(0601)  C DISPLAY  HEADING  ON  TERMINAL  FOR  RESPONSIBLE  ENGINEER 

(0602)  CALL  SCRNHO(ITEM) 

(0603)  C DISPLAY  RECORD  OF  ENGINEER  FOUND 

(0609)  16d  CALL  SCRNPT(ITEH) 

(0605)  C IS  THIS  A NEU  PAGE  ON  THF  PRINTER 

(0606)  IF(IPRINT.NE.O)  GOTO  170 

(0607)  C PRINT  HEADING  ON  PRINTER  FOR  RESPONSIBLE  ENGINEER 

(0608)'  CALL  HARDHD(ITEH) 

(0609)  IPRINT=1 

(0610)  C PRINT  RECORD  OF  ENGINEER  FOUND 

(0611)  170  CALL  HARDPT(ITEM) 

(0612)  C IS  THIS  THF  DOTTCK  OF  THE  PRINTER  PAGE*  YES  SET  TOP  OF  PAGE  FLAG 

(0613)  190  IF(KNT/19.E0.KNT/19.)  IPRINT=0 

(0619)  60T0100 

(0615)  C DISPLAY  HOW  MANY  WERE  FOUND 

(0616)  200  URITE(1*300) 

(0617)  300  FORMATC  •/) 

(0610)  WRITE(1,250)KNT,DRE 

(0619)  250  FORHAT(»  THERE  ARE  *I9*  DOCUMEMTS^U I TH  A RESPONSIBLE** 

(0620)  11X.*ENGINEEP  OF  *A3) 

(0621)  RETURN 

(0622)  END 


\ 
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(0625) 
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(0635) 
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(0641) 
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(0644) 


SUBROUTINE  CNUM 
C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 
C 

COMMON/BLK/  MS* ATHR,DD«TC,DLN»SUBtROUT,IDD»CUA  iCONT» 

1 AODtTUX,FSC»NRE,DOTtR,PTITtCOUNT,CON 

COMMON /SRC/  KNT,DM,OA,DDD.DTO,DL»IT»D»UA,DU,DT,DRE 
1 , TFVD,TLVD»FVD,LVD»IEX 

COMMON /FLA/  I T R SP  » I MFLE  ♦ I TU’FX  » I ANN  » I PR  , I M I S » I READ 
INTFGEk*4  AThR  ( 7)  »T0(8)«DLN(5)  ,r,UB(21)  tR0UT(6)  .PTIT  (19)  , 

1 C0r.;(5)tTUX(6,5)  ,FRC(f  ) tNRLd  .3)  .0nT(30«21  ) »T(21) 

1 .TIT(24) ,cnUNT,C0NT(5)*irX(4,3) 

INTEGER  *2  MS  t PD ( 3 ) ♦ 1 00  ( 3 ) , A PO  ( 3 ) , R , C U A (4  ) , t’A  ( 4 ) 

INTEGER ‘2  ITRSPiIMfLF»ITUFX*IANN,IPR,IMIS,IREAD 
INTFGER*2  F VP ( 3 ) , LV D ( 3 ) , D ( 3) . DM, ODD ( 3 ) 

INTEGER*4  DRF »DT( 5 ) ,DU(5) .0L(5 ) »DA(7) , IT<24) ,DTO(B) «KNT 
DOUBLE  PRECISION  DT J . T F t TL , TJ UL ♦ IF VO , TL VD» T I Hi T J 
C SYSCOM>KEYS.F  HNEHCNIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER*2  IPAGEiIPRINT 

KNT  = 0 

IPAGE=0 

IFRINT=0 

3 URITE(lil) 

1 FORHAT(*  CONTRACT  NUMBER  SEARCH*,/, 

1 * UHAT  IS  THE  DESIRED  CONTRACT*/) 

READ(1,2,ERR=3)DU 

2 FORHAT(5A4) 

C READ  POCUHFNT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 

100  CALL  RDSUB 

C IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 

IF(IREAD.EQ.l)  GOTO  190 
IM=IDD(1) 

10=100(2) 

IY=I0D(3) 

CALL  JTIMEdYiIM, IP, 0,0,0, TIM) 

1KTFVO.lt. TIM. AND. TIM. LE.TLVD)GO  TO  890 
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(0645J  00  TO  100 

(0646)  P90  CONTINUE 

(0647)  DO  660  1=1»E 

(0648)  IF(DW(l).NE.CONT<I))  GOTO  100 

(0649)  660  CONTINUE 

(0650)  150  IF(IPAGF.NE.O)  GOTO  160 

(0651)  ITCK=10 

(0652)  IPAGE=1 

(0653)  CALL  SCRNHD ( 1 TFH) 

(0654)  160  CALL  SCRNPT(ITEH) 

(0655)  IF( IPRINT.NE.O)  GOTO  170 

(0656)  CALL  HARDHD  ( ITEf*) 

(0657)  IPRINT-1 

(0658)  170  CALL  HARDPT(ITFK) 

(0659)  IF(KNT/14.EQ.KNT/14.)  IPRINT=0 

(0660)  GO  TO  100 

(0661)  190  WRITE(lt300) 

(0662)  300  FORHAT(»  •/) 

(0663)  WRITE(l«250)KNTfDU 

(0664)  250  FORHAT(»  THERE  ARE  *19*  DOCUMENTS  UITH  A CONTRACT** 

(0665)  IIX. 'NUMBER  OF  »5A4) 

(0666)  RETURN 

(0667)  END 
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(0690  ) 


SUBROUTINE  CWAID 

THIS  SUBROUTINE  PERFORMS  THE  UA  NUMBER/ID  CODE  SEARCH 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COMHON/BLK/  MS t ATHR ♦ DD ♦ TO f DLN , SUB » ROUT , I DO • C UA  «CONT, 

1 ADD»TUXiFSC,NREfDOTtR»PTIT»COUNTtCON 
COKKON/SRC/  KNT,DH,PA,DDDiDTO,DL,IT,D*UA,DU.DT,DRE 
1 iTFVD,TLVD,FVD,LVDtIEX 

COHHON/FLA/  ITRSP,IHELE»ITUFXfIANNtIPR,IHIS*IREAD 
INTEGER***  ATHR<7),T0<8)*DLN(5)  »SUB<21)  »R0UT(6)fPTIT(19)» 

1 CON(5)tTWX<6,5)»FSC<6)fNRL<l»3)fDOT<30»21)»T<21) 

1 «TIT(29)  . COUNT  tC0NT(5)tUX  (4,3) 

I NT EGER *2  MS ,DD ( 3 ) ♦ I CD ( 3 ) , ADD ( 3 ) ,R ,CUA  < 9 ) , VA  < 9 ) 

INTEGER*2  I TR SP 1 1 ML L E , I TUF X , I ANN ♦ IPR * I M I S » I RE AD 
INTEGER*2  FVD(3)»LVn(3)*D(3),DM»D00(3) 

INTEGER*9  0RE*DT<5)»Dy(5),DL(5),DA<7)»IT(29) «DT0<8) »KNT 
DOUBLE  PRECISION  D T J , TF ♦ T L»  T JIJL»  TF V D, TL VDt  T 1 H , T J 
INTEGER*2  IPAGEtIPRINT 
INITIALIZE  COUNTER 
KNT  = 0 

INITIALIZE  FIRST  FOUND  FLAG 
IPAGE=0 

INITIALIZE  TOP  OF  PRINTER  PAGE  FLAG  ' 

IFRIN7=0 

URITEdtl) 

FORMAK*  U.A.  NUMBER/ID.  CODE  SEARCH**/* 

1 * WHAT  IS  THE  DESIRED  CODE*/) 

READ(1,2*ERR=3)UA 

F0RHAT(9A2) 

READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 
CALL  RDSUB 

IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 
IFdKEAD.EQ.l ) GOTO  2C0 
IH=IDD(1) 

ID=IDD<2) 

IY=ID0(3) 

CALL  JTIHE( I Y* IM* ID*0*0*0*TIH) 


Z9-a 
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(0691  ) 

ihTFVD.LT.TIH.AND.TlH.LE.TLVDlGO  TO  890 

(0692) 

GO  TO  100 

(0S53) 

890 

CONTINUE 

(0b9‘!) 

IF(UA(A).NE.»  *>  GOTO  5 

(0695) 

IF(UA(3).NE.»  •)  GOTO  AO 

(0696) 

DO  30  1=1*2 

( 0r,9  /) 

1F(WA(I).NE.CWA(I))  GO  TO  ICO 

(0698) 

30 

CONTINUE 

(0699) 

GO  TO  150 

(0700) 

AO 

DO  50  1=1.3 

(0701 

IF(UA(I).NE.CUA(I))  GOTO  100 

(07J2) 

50 

CONTINUE 

(0703^ 

GO  TO  150 

(C7i  A) 

5 

DO  10  I=1*A 

(0705) 

IFC.'A  ( I ).NE.CUA(I  ) ) GOTO  100 

(0706' 

10 

CONTINUE 

((707) 

C 

WA  NUMBER  / ID  CODE  FOUND 

(C7!8) 

c 

IS  THIS  THE  FIRST  RECORD  FOUND 

(0709: 

150 

IF(IPAGE.NE.O)  GOTO  160 

(0710)  C SET  UP  FOR  DISPLAY  ON  TERMINAL 

(07U)  ITEH  = 9 

(071?)  IPAGE=I 

(0(13)  C DISPLAY  HEADING  ON  TERMINAL  FOR  UA  NUHBER/IO  CODE 

(071'(5  CALL  SCRNHD(ITEM) 

(C'715)  C DISPLAY  RECORD  OF  DOCUMENT  FOUND 

(0716*  160  CALL  SCRNPT(ITEM) 

(07:7)  C IS  THIS  THE  TOP  OF  PRINTER  PAGE 

(07ie:  IF(IPRINT.NE.O)  GOTO  170 

(07)9)  C PRINT  HEADING  ON  PRINTER  FOR  UA  NUMDER/IO  CODE 

(07?0)  CALL  HAROHO(ITFK)  • 

(07DJ)  IPRINT=1 

(07?i)  C PRINT  RECORD  OF  DOCUMENT  ON  PRINTER 

(07?3J  170  CALL  HARDPT(ITEM) 

(07?A)  C IS  THIS  THE  BOTTOM  OF  PRINTER  PAGEt  YES  SET  TOP  OF  PAGE  FLAG 

(072B)  190  IFIKNT/IR.EC.KNT/IA.)  IPRINT=0 

(0726)  GO  TO  100 

(0727)  C DISPLAY  THE  NUMBER  OF  DOCUMENTS  FOUND 

(0728)  200  URITE(lt300) 


> t 
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<0729 

(07^0) 

(0731. 

(07;  2) 

(0733) 

(0730 


300  FORMAK*  •/) 

URITE(1.250)KNTtWA 

250  FORHATC  THERE  ARE  »I9*  DOCUMENTS  UlTH  A U.A.  NUMBER*. 
1 13H/ID.  CODE  OF  ,AA2) 

RETURN 

END 
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$0735) 

SUBROUTINE  DLSEA 

(0736) 

C 

THIS  SUBROUTINE  PERFORMS  THE  DOCUMENT /L ETTER  NUMBER  SEARCH 

(073. ) 

C 

f 0 137) 

C 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

(0737: 

C 

(O  '.  37) 

COMMON/BLK/  HS,ATHR,DD«TO,DLNfSUB.ROUT,IDDfCUA.CONT» 

(0737) 

1 At)0*n)X,FSCtNRE»ODT,R,PTIT»COUNT,CON 

(0737) 

COMMON /SRC/  KNT,DH,I)A»DOO*OTO,DL»l  T,D,UA«DW»OT»DRE 

» 0 73'') 

1 »TFVr),TLVD.FVD,LVO.IEX 

(O'.  37) 

COMMON/ FLA/  I TR  SP  , I MFLE  , I T k!F  X , I ANN  t IP  R , I M I S » IRE  AD 

(0737) 

INTEGER  *5  A THR ( 7) , T 0 ( ft ) , DLN ( 5 ) t SUB ( 2 1 ) , ROUT ( 6 ) ,P T IT ( 1 9 ) « 

(0737) 

1 CON(5)tTUX(b,5) ,FSC(f ) ,NRE(1 ,3) *ODT(30  f21 ) ♦T(21 ) 

(0737) 

1 »TIT{25),COUNT,COHT(5)»IEX(5,3) 

(0737) 

INTEGER»2  MS ,DD ( 3 ) » IDD ( 3 ) t ADD ( 3 ) f R ,CUA ( 5 ) « WA ( 5 ) 

(0737) 

INTFGER*2  I TRSP 1 1 Mt LE 1 1 TUFX , I A NN » I PR » IM I S 1 1 R E AD 

(073'a) 

INTEGER*2  F VD ( 3 ) , L VD ( 3 ) , 0 ( 3 ) ♦ D.« . DOD ( 3 ) 

CD 

1 

(0737) 

INTEGER  *5  DKE,Dl(5),Dl.'(ri)«DL(5),DA(7)tIT(25)  ,DT0(8)  »KNT 

(0  73'.  ) 

DOUBLE  PRECISION  D T J , TF » TL i T JUL . TF VO » TL VD * T I Hf T J 

(0':38) 

INTEGER*2  IFAGEtlPRlNT 

'sj 

(0735  ) 

C 

INITIALIZE  FOUND  COUNTER 

(0740) 

KNT  = 0 

(0751) 

C 

INITIALIZE  FIRST  FOUND  FLAG 

(0752) 

IPAGE=n 

n753> 

C 

I.MTIALIZE  TOP  OF  PRINTER  PAGE  FLAG 

(0755  ) 

IPRINT=0 

(0755) 

3 

WRITEdtl) 

(075b) 

1 

FORMAT! • DOCUMENT/LETTLR  NUMBER  SEARCH**/* 

(0757) 

1*  WHAT  IS  THE  DESIRED  DOCUMENT  NUMBER*/) 

(075ft) 

RFADd  *2*ERR-3)DL 

(0759) 

2 

FORMAT (5A5, A2) 

(0750) 

WRITFd,2)DL 

(0751) 

C 

READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE'  SUB-FILE 

(0752) 

100 

CALL  pcsue 

(0753) 

c 

IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 

(0755' 

IF(IRCAO.EO.l)  GOTO  200 

(0755) 

IH=IDD(1) 

(07ob) 

ID=IDD(2) 

(0757) 

IY=1DD(3) 
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(07581 
(0759) 
(0?60) 
(0761)  890 

(0762  > 

(0763) 
(C76A)  101 

(07655  C 
(0766)  C 
(0767)  150 

(0768)  C 
(0769) 

(0770)  ■ 
(0771)  C 
(07  725 
(0773)  0 

(077A)  166 

(0775)  C 
(0776) 
()777)  C 
(0778) 
(0779) 
(07805  C 
(0761)  170 

(076,2)  C 
(0783)  190 

(073A) 
(0785)  C 
(OVeG'  200 
(0707)  300 

(0788‘ 
(0769)  250 

(0790) 

(079  L> 
(0792) 


call  JTIHE(IY»IH»ID,0»0»0,TIH) 

IF(TFV0.LT.T1M.AND.TIH.LE.TLVD)G0  TO  890 
GO  TO  100 
CONTINUE 
DO  101  I=l»5 

IF(DL(1).NE.DLN(D)  go  to  100 
CONTINUE 

DOCUF.ENT  /LETTER  NUKBER  FOUND 
IS  THIS  THE  FIRST  DOCUMENT  FOUND 
IF( IPAGE.NE.O)  GOTO  160 
SET  UP  FOR  DISPLAY  OF  DOCUMENT 
ITEH=5 
1PAGE=1 

DISPLAY  HEADING  ON  TERMINAL  FOR  DOCUMENT  NUMBER 
CALL  SCP.NHD(ITEM) 

DISPLAY  RECORD  OF  DOCUMENT  FOUND 
CALL  SCRNPTdTFM)  • 

IS  THIS  A NEU  PACE  ON  PRINTER? 

IF(IPRINT.NE.O)  GOTO  170 

PRINT  HEADING  ON  PRINTER  FOR  DOCUMENT/LETTER  NUMBER 
CALL  HARDHD(ITEM) 

IPRINT=1 

PRINT  RECORD  OF  DOCUMENT /LETTER  NUMBER 
CALL  HARDPTdTEM) 

IS  THIS  THE  BOTTOM  OF  PRINTER  PACE, ' YES  SET  TOP  OF  PAGE  FLAG 
IF(KNT/1').EC.KNT/1A.)  IPRINT  = 0 
GO  TO  100 

DISPLAY  THE  NUMBER  OF  DOCUMENTS  FOUND 
URITE(1»30C) 

FORMAT!’  •/)  • 

WRITE(i»250)KNT,DL 

FORMAT!’  THERE  ARE  ’19’  DOCUMENTS  WITH  DOCUMENT  /.LETTER  NUMBER’. 
llXt’OF  ’AAA,A2) 

RETURN 

END 
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SUBROUTINE  AUSEA 

THIS  SUBROUTINE  PERFORHS  THE  AUTHOR  SEARCH  FOR  MAR  LOG 

DATA  OFCLARATION  AND  COHKON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COKHON/ELK/  HS, ATHP , DO . TO , DLN, SUB « ROUT, I TO , CUA ,CONT, 

1 ADD,TUX,FSC»N8F,DDT,R,PTIT,C0UNT,C0N 

COMMON /SRC/  KNT,DH,nA,r)Dn»nTO,OL,IT,D,UA,DU,DT»DRF 
1 ,TFVD,TLVD,FVD,LVD,IEX 

COMMON /FLA/  ITRSP,IMLLr,ITU'FX.IANN,IPR,IHIS,IRFAD 
INTEGER»4  A T HR ( 7) , TO ( 8 ) , OLN ( 5 ) , SUB ( 2 1 ) » R OUT ( 6) ,P T I T ( 19 ) , 

1 C0N(5),Ti;x(6,5).,FSC(r,),NRf  (1,3),  DOT  (30,21  ),T  (21) 

1 ,TI  T(24)  ,C0UrjT,C(UJT(5)  ,If  X(4,3) 

INTEGER»2  MS  , L’D  (3  ) , I DO  ( 3 ) , ADO  ( 3 ) , 8 , C UA  ( 4 ) , IJA  ( 4 ) 

INTEGER*2  I TRSF  , I MFLE  , I TL' F X , I AMN  , IPH  , IM  IS,  I RE  AD 
INTEGER*2  F VD  ( 3 ) , L VfH  3 ) , D ( 3 ) , D". , DDD  ( 3 ) 

INTEGER *4  DRE,DT(5),DW(5),0L(5) ,DA ( 7) , IT(24),0T0(8),KNT 
DOUBLE  PRECISION  DT  J , TF  , TL  , T JUL , TF  VI) , TL  VO,  T I M,  7 J 
INTEGER*2  IPAGE,IPRINT 
INITIALIZE  THE  FOUND  COUNTER 

knt=o 

INITIALIZE  THE  FIRST  FOUND  FLAG 
IPAGE=C 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPRINT=0 
URITE(1,1) 

FORMAT! • THIS  IS  THE  DOCUMENT  AUTHOR /SOURCE  SEARCH*,/, 

1*  U'HAT  IS  THF  DESIRED  AUTHOR/SOURCE*,/) 

READ(1,2,ERR=3)DA 

F0PMAT(7A4) 

WRITE(1,2)DA 

READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 
CALL  RDSUO 

IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 
IF ( IREAD.EG.l ) GOTO  200 
IH=IUD(I) 

IO=IDD(2) 

IY=IOO(3) 


I 


(C81..)  CALL  JTIME(IY,IH,lDf0i0,0«TIM) 

(0C17>  IF(TFVD.LE.TIH.AND.TIM.LE.TLVO)GO  TO  890 

(061L)  GO  TO  100 

(0P19)  890  CONTINUE 

(0820)  DO  101  1=1»7 

(0821)  IF  ( ATHRd  ) .NE.OAd  ) ) GO  TO  100 

(0822)  101  CONTINUE 

(0F2j)  C AN  AUTHOR  WAS  FOUND  AND  HATCHFD 

(0824)  C IS  THIS  THE  FIRST  DOCUMENT  FOUND  WITH  THE  AUTHOR 

(0825)  150  IF(IPAGE.NE.O)  GOTO  160 

(0826)  t SET  UP  FOR  DISPLAY  OF  DOCUMENT 

(0627)  ITEM=2 

(0828)  IPAGE=1 

(0629)  C DISPLAY  HEADING  ON  TERMINAL  FOR  AUTHOR 

(0830)  CALL  SCRNHDdTEH) 

I (0331)  C DISPLAY  RECORD  OR  DOCUMENT  FOUND  WITH  AUTHOR 

(0632)  160  CALL  SCRNPT(ITEH) 

^ (0633)  C IS  THIS  A MEW  PAGE  ON  PRINTER 

(083**)  IFdPRINT.NE.O)  GOTO  170 

(0835)  C PRINT  HEADING  ON  PRINTER  FOR  AUTHOR  SEARCH 

(0636)  CALL  HARDHDdTEM) 

(0837)  IPRINT=1 

(J838)  C PRINT  RECORD  OF  DOCUMENT  FOUND  FOR  AUTHOR 

(0839)  170  CALL  HARDPT(ITEH) 

(OOAO)  C IS  THIS  THE  BOTTOM  OF  PRINTER  PAGE»  YES  SET  TOP  OF  PAGE  FLAG 

(OFjAI;  190  IF(KNT/1A.EG.KNT/1A.)  IPRINT=’0 

(0892)  GO  TO  ICO 

(0893)  C DISPLAY  THF  NUMBER  OF  DOCUMENTS  FOUND 

(03.99)  200  WHITE(1»300) 

(0895)  300  FORMAT(*  •/) 

(0896)  WRITEd  ,250)KNT  ,DA 

(0897  250  FORMAK*  THERE  ARE*15»  DOCUMENTS  WITH  A AUTHOR /SOUR CE  OF»t/' 

(0848)  1 7A9) 

(0899,  RETURN 

(0850)  END 
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SUBROUTINE  HSTAT 

THIS  SUBROUTINE  PERFORMS  THE  HAIL  STATUS  SEARCH 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE; 

COHMON/BLK/  MS, ATHR , DO, T 0 ♦ OLN , SUB ♦ ROUT » I DO . CWA .CONT t 
1 ADD, TWX,FSC,NRE, DDT, R, PTI  T, COUNT, CON 

COMMON /SRC/  KNT,DH,DA,nOD,DTO,r'L,lT,n,WA,DU,DT,ORE 
1 ,TFVD,TLVD,FVD,LVO,ILX  ■ 

COHHON/FLA/  I TRSP, IMLLF , 1 TUFX , I ANN , IPR , IH IS, I RE AD 
INTEGER»A  AT  HR (7) ,TO( 8) , DLN ( 5 ) , SUB ( 21 ) , R OUT ( 6 ) ,P T I T ( 19  ) , 

1 C0N(5),U'X(6,5)  ,FGC(f,),Nltt  <1,3),DDT(30,21),T(21) 

1 ,TIT(2A) ,C0UNT,C0NT(5),ICX(A,3) 

INTEGER *2  MS , DD ( 3 ) , IDD ( 3 ) , ADD ( 5 ) , R , C WA ( A ) , WA ( A ) 

INTEGER *2  I TRSP  , I Mr LE , 1 T WFX , I A NN , IPR , I M I S, I RE  AD 
INTEGER*?  FVC(3),LVn(3),0(3),DM,DDD(3) 

INTEGER*A  0 RE , DT ( 5 ) , DU ( 5 ) , DL ( 5 ) , D A ( 7 ) , I T ( 2 A ) , DTO ( 8 ) , KNT 
DOUBLE  PRECISION  DT J , TF , TL , T JUL , TF VD , TL VD , T I H, T J 
INTEGER*?  FD(3) ,LD(3) 

INTEGER*?  IPAGE,IPRINT 
INITIALIZE  THE  FIRST  FOUND  FLAG 
IPAGE=r 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
1FRINT=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

URITF(1,1) 

FORMAT!*  THIS  IS  THE  HAIL  STATUS  SEARCH  ROUTINE  »,/, 

1*  PLEASE  INPUT  THE  DESIRED  HAIL  STATUS  ( VC , IH, OH ) » , /) 
READ(1,3,ERR=10)DH 
FORMAT! A2) 

IS  THIS  ENTRY  A VALID  HAIL  STATUS,  YES  CONTINUE  . 
IF(DH.EO. *IH*)  GO  TO  11 
IF(DM.EQ.*OH*)  CO  TO  11 
IF(UH.EO.*VC*)  GO  TO  11 
NOT  A VALID  ENTRY,  DISPLAY  ERROR  MESSAGE 
WPITE(1,A)DH 

FORMAT! *GCERROR  IN  HAIL  STATUS  *A2*  NOT  ALLOWABLE*/ 
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1*  TRY  AGAIN*i/) 

GO  TO  10 
CONTINUE 

READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 
CALL  RDSUB 

IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 
IF(lREAD.EO.l)  GOTO  200 
CLEAR  TIME  FRAME  FLAG 
IH=IDD(1) 

ID=IOD(2) 

IY=IDD<3) 

CALL  JTIME<IYtIM»ID*O*0tO»TJUU 
1F(TJUL.LT.TFVD.0R .TJUL.GT.TLVD)  GOTO  100 
IF(HS.NE.DH)  GO  TO  100 
A KAIL  STATUS  WAS  FOUND  AND  HATCHED 

IS  THIS  THE  FIRST  DOCUMENT  FOUND  WITH  THE  SELECTED  MAIL  STATUS 
IF(IPAGE.NE.D)  GOTO  160 
SET  Ur-  FOR  DISPLAY  OF  DOCUMENI 
ITEM=1 
1PAGE=1 

DISPLAY  HEADING  ON  TERMINAL  FOR  HAIL  STATUS 
CALL  SCRNHD(ITEM) 

DISPLAY  RECORD  OF  DOCUMENT  FOUND  WITH  SELECTED  HAIL  STATUS 
CALL  SCRNPT(ITEM) 

IS  THIS  A NEW  PAGE  ON  PRINTER 
IF(IPRINT.NE.O)  GOTO  170 
PRINT  HEADING  ON  PRINTER  FOR  MAIL  STATUS 
CALL  HARDHD (ITEM) 

IPRINT=1 

PRINT  RECORD  OF  DOCUMENT  FOUND  FOR  HAIL  STATUS 
CALL  HARDPTdTEM) 

IS  THIS  THE  BOTTOM  OF  PRINTER  PAGE,  YES  SET  TOP  OF  PAGE  FLAG 
IF (KNT/IA .EQ.KNT/IA. ) IPRINT=0 
GO  TO  100 

DISPLAY  THE  NUMBER  OF  DOCUMENTS  FOUND 
UhITE(l,300> 

FORMAT!*  •/> 

URITE(1,201)  KNT,DK 
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(091?>  201  F0RHAT(»  THERE  AREMIO*  DOCUMENTS  WITH  A HAIL  STATUS  OF  »t 

1091?)  1 A2/> 

(O'.IA)  RETURN 

(0919)  END 


D3 


VO 


SUBROUTINE  HSTAT 


ADD 

1 

/DLK/ 

000163 

0853S 

ATIiR 

J 

/fiLK/ 

000001 

0B53S 

CON 

J 

/LLK/ 

002731 

C853S 

CCNT 

J 

/DLK/ 

000151 

0853S 

COUNT 

J 

/BLK/ 

002727 

0653S 

CWA 

I 

/BLK/ 

OOOIAC 

C853S 

n 

I 

/SRC/ 

000136 

C853S 

DA 

J 

/SRC/ 

000  003 

08535 

OD 

I 

/ELK/ 

000017 

C853S 

ODD 

I 

/SRC/ 

000021 

C853S 

DDT 

J 

/ELK/ 

D0030A 

0853S 

CL 

J 

/SRC/ 

COOOA4 

C853S 

DLN 

J 

/bLK/ 

OOOOA2 

0853  S 

CM 

I 

/SRC/ 

000002 

0853S 

f911 

DRt 

J 

/SRC/ 

000171 

0853S 

DT 

J 

/SRC/ 

000157 

0853S 

DTJ 

0 

COOOOO 

0853S' 

CTO 

J 

/SRC/ 

00002A 

0853S 

DW 

J 

/SRC/ 

0001A5 

C853S 

FC 

I 

000002 

C854S 

Fsr 

J 

/ELK/ 

000262 

08535 

f VO 

I 

/SRC/ 

000203 

0853S 

HARDHO 

R 

EXTERNAL 

000000 

0901 

HARDPT 

•R 

EXTERNAL 

000000 

0904 

lANN 

I 

/FLA/ 

000003 

0853S 

ID 

I 

00056? 

0883H 

ICD 

I 

/ELK/ 

000142 

0853S 

I EX 

J 

/SRC/ 

000211 

0853S 

IM 

I 

000563 

0882M 

ihele 

I 

/FLA/ 

000001 

0853S 

7«IS 

I 

/FLA/ 

000005 

0853S 

IPAGE 

I 

000564 

C855S 

nR 

.1 

/FLA/ 

000004 

C853S 

IPRINT 

I 

000565 

C855S 

IREA9 

I 

/FLA/ 

000006 

C853S 

IT 

J 

/SRC/ 

000056 

0853S 

ITEM 

I 

000566 

0892K 

0865K  0868  0869  0870  0872 


0885A 

0882 

0883 

0884 

0885A 

• 

0857H 

0890 

0893H 

0859H 

0880 

0899 

0902H 

0906M 

0895  A 

0897A 

0901  A’ 

0904A 
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ITRSP 

I 

/FLA/ 

oooooo 

0853S 

ITUFX 

I 

/FLA/ 

000002 

0853S 

IV 

1 

000567 

088AM 

0885A 

JTIHE 

I 

EXTERNAL 

oooooo 

0885 

KNT 

J 

/SRC/ 

OOOOOO 

0853S 

0861M 

LD 

I 

000005 

085A  S 

LV  3 

I 

/SRC/ 

000206 

0853S 

.IS 

I 

/t'LK/ 

OOOOOO 

0853S 

0887 

MS  fAT 

I 

OOOOOO 

0851  S 

■\RE 

J 

/BLK/ 

000276 

0853S 

PT  n 

J 

/1-LK/ 

002661 

0853S 

R 

I 

/:iLK/ 

002660 

0853S 

RDSUB 

R 

EXTERNAL 

f'OOOOO 

08  78 

ROUT 

J 

/'  LK/ 

000126 

0853S 

SCRNHO 

R 

EXTERNAL 

OOOOOO 

0895 

SCRNPT 

R 

EXTERNAL 

OOOOOO 

0897 

SUB 

J 

/ELK/ 

00005A 

0853  S 

T 

J 

GOOOlO 

0853S 

TF 

D 

OOOOOO 

C853S 

TFVD 

D 

/SRC/ 

000173 

0853  S 

0886 

TIM 

D 

OOOOOO 

0853S 

TIT 

J 

000062 

C853S 

To 

D 

OOOOOO 

0853S 

T.'UL 

0 

000573 

0853S 

0885A 

TL 

D 

OOOOOO 

0853S 

TLVO 

D 

/SRC/ 

000177 

0853S 

0886 

TO 

J 

/ELK/ 

00002? 

C853E 

TUX 

J 

/PLK/ 

000166 

0853G 

u:. 

I 

/SRC/ 

OOOlAl 

0853S 

1 

000161 

0862 

08630 

00015A 

08620 

0865 

_10  0 

0003A5 

08780 

0886 

11 

0003A5 

0868 

0869 

150 

000A27 

00900 

160 

OOCAAO 

0890 

08970 

170 

000A51 

0899 

pnoAO 

_15C 

C00<t53 

09060 
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0906  0911 


0886 


0875 

0887  0907 

0870  08760 
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_2C0 

000501 

0880 

09090 

_20i 

000523 

0911 

09120 

_3 

000255 

0865 

0866D 

~3  0 0 

000505 

0909 

0910D 

~A 

000305 

0872 

0873D 

0000  ERRORS  t<HSTAT  >FTN-REV1A.2 3 
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(0916) 

(C917) 

(0917) 

(C917) 

(091  n 

(C917) 
(09171 
(0917) 
(09)7# 
(0917# 
,0917) 
(0)17) 
(0917) 
(0917) 
(0917) 
(0917) 
(P91 7) 
(0913) 
(0919) 
(092(  ) 
(0921) 
(0921) 
(0922) 
(0923) 
(092';) 
(0925) 
(092b) 
(0927) 
(0928) 
(0929) 
(0930) 
(0931) 
(0932) 
(0933) 
(0939) 
(0935) 
(0936) 
(0937) 


SUBROUTINE  SUBJ 
C 

C DATA  DECLARATION  AND  COMHON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

COMKON/BLK/  MS*  ATHR , DD » TO « OLN, SUB* R OUT, I DO t CUA  *CONT, 

1 ADD*TUX,FSC,NRE*DDT*R*PTIT*COUNT,CON 

COMMOM/SRC/  KNT*DH*DA*ODD*DTO*r)L,IT*D,UA*DU,DT*DRE 
1 *TFVU*TLVD*FVD*LVD*1LX 

COMMON/ FLA/  I TR SP * I MELE * I TUFX * 1 ANN  * IPR * 1 M I S * I R E AD 
INTEGERoA  ATHR( 7) , T 0 ( 8 ) * OLN ( 5 ) * SUB ( 21 ) * R OUT ( 6 ) *PT IT ( 19 ) , 

1 COf,  (B),TUX(6,5)  *FSC((  ) *NRE(1*3),DDT(30*?.1),T(21) 

1 *T1T(29)  *C0l)(n*C0NT{5>*IEX.(A*3) 

INTEGER«2  MS*DD(3)  *IOD(3>  ,Ar;D(3)  *R,CUA(9)*  UA(9) 

INTrGER*2  ITRSP*IMLLE*nWFX*IANN,IFR*IHIS,IREAD 
INTEGER  *2  F VD  ( 3 ) * LV  ? ( 3 ) * D ( 3)  , [i.’' * ODD  ( 3 ) 

INTEGER *9  DR F *DT( 5 ) * OW ( 5 ) * DL ( 5 ) , DA ( 7 ) * I T ( 29 ) , DTO ( 8 ) ,KNT 

DOUBLE  PRECISION  DT J * TF * T L * T JUL * TF VO  * TL VD * T I H, T J 

INTEGER‘2  C CC * T 1 , I N * I CON , 1 0 

INTFGER*9  ELNK 

IN7EGER*2  I PAGE  * I PR  I NT  * I OPT 

C SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

C INITIALIZE  THE  TEMPORARY  FILE  INDICATOR 

T1=0 

G INITIALIZE  THE  FIRST  FOUND  FLAG 

IPAGE=0 

C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

IPKINT=0 

C INITIALIZE  THE  FOUND  FLAG 

KNT=0  . 

C SET  EXTRA  WORD  FOR  SEARCH  TO  BLANKS 

DO  8000  1=1*9 
DO  8001  J=l,3 

IEX(I*J>='  * 

8001  CONTINUE 
8000  CONTINUE 

r CLEAR  THE  USER  TERMINAL  SCREEN  FOR  DISPLAY 

CALL  CLEAR  . • 
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(O930j  lOfll  WRlTr(l»2) 

(0939)  2 FORMAT!*  HOW  MANY  WORDS  DO  YOU  WISH  TO  HATCH  (MAX  OF  4)*,/ 

(0940)  1/) 

(0941)  READdtP.ERRrlOODICON 

(9942)  8 F0RHATCI2) 

(0943)  C HAKE  VALIDITY  CHECKS  ON  NUMBER  OF  WORDS  TO  SEARCH 

(0944)  IFdCON.LT.l  > GO  TO  1001 

(0945)  IF(IC0N.GT.41  GO  TO  1001 

(09*6)  DO  1000  L00P=1,IC0N 

(0947)  WRITFd  ,1  ) 

(0948)  1 FORMAT!*  WHAT  IS  THE  DESIRED  WORD**//) 

(0949)  C FETCH  THE  WORD  TO  EE  SEARCHED 

(0950)  . LEN  = 10 

(0951)  CALL  TINPUT! IT,LEN) 

(0952)  C IS  THE  WORD  QUIT.  YES  RETURN 

33  (0953)  IF(IT(1).EQ.*QUIT*)  GO  TO  1002 

; ' (0954)  C SAVE  SEARCH  WORD 

(09c5)  DO  B003  1=1.3 

(0656)  IEX(LOOP. I ) =IT(I) 

(0957)  8003  CONTINUE 

(U958)  C 

(09j9)  C open  TEHORARY  FILES  FOR  SEARCH 

(0960)  C 

(0961)  CALL  SRCH1S(K$RDUR+K$NDAH,*T1*.2.15.1.IC) 

(0962)  CALL  SR.  CH  t $ (K$R6'UR*K  SNO  A M,  • T2  » , 2 . 1 6. 1 . 1 C) 

(0963)  C REWIND  ALL  NEEDED  SUBFILES 

(0964)  IF(ITRSP.EO.l)  REWIND  6 

(0965)  IF(IMELE.EQ.l)  REWIND  11 

(0966)  . IF(ITWFX.EQ.l)  REWIND  12 

(0967-  IFdANN  -EQ-1)  REWIND  13 

(09o8)  IFdPR  .EG.l)  REWIND  14 

(0969)  IFdHIS  .EQ.l)  REWIND  15 

(0970)  C 

(0971)  C DETERMINE  TEMORARY  FILE  FOR  INPUT  AND  OUTPUT 

(0972)  C 

(0973)  IF(Tl.EQ.O)  IN=20 

(09''4)  IF(Tl.EG.O)  10  = 19 

(0975)  IF(Tl.EO.l)  1N=19 


B-85 


SUBROUTINE  SUBJ 


(0976) 

IFITl.EO.l)  10=20 

(0977) 

IF(T1.EQ.2)  IN=20 

{C978) 

IF(T1.EQ.2)  10=19 

(C979) 

IF(T1.EQ.3)  IN=19 

(0980) 

IF(T1.E0.3)  10=20 

(0981) 

IF(T1.EQ.4)  IN=20 

(0981.') 

IF(Tl.rn.ft)  10=19 

(0983) 

C 

INITIALIZE  TEMPORARY  FILE  DOCUMENT  COUNTER 

(098‘tr 

DOC  = 0 

(0V8b; 

C 

SET  INPUT  FILE  TO  TOP  OF  FILE 

(0986) 

REWIND  IN 

(098?; 

C 

SET  OUTPUT  FILE  TO  TOP  OF  FILE 

^0988) 

REWIND  10 

(0''89) 

C 

IS  THIS  THE  FIRST  WORD  SEARCH 

(0990 

5 

IF(Tl.NE.O)  GOTO  50 

(0991) 

C 

READ  SUBFILE  SELECTED  FOR  SEARCH 

(0992) 

CALL  RDSUB 

(0993) 

C 

IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUBFILES 

(C99<i) 

IF(IREAD.EO.l)  GOTO  100 

(099b) 

GO  TO  E5 

( 0996  ) 

C 

READ  TEMPORARY  SEARCH  FILE 

(0997) 

50 

READ  (IN«END  = 10  0 )MS,ATHRtDD»TO«OLN»SUB»PTIT» 

(0998) 

1 ROUT» IDD*COUNTtCWAtCCNT, ADD»TWX,FSC»NRE 

(0999) 

C 

STORE  THE  INPUT  DATE 

(1000) 

55 

I.“.  = IDD(1) 

(1001) 

ID=1DD(2) 

(1002) 

IY=IDD(3) 

(1003) 

C 

CONVERT  INPUT  DATE  TO  JULIAN  TIME 

(iro^) 

CALL  JTIME( lYtlM, ID*0»n»0»TIH) 

(1005) 

C 

IS  THE  DATE  WITHIN  THE  TIME  FRAME  OF  SEARCH 

(1  006.) 

IF(TFV0.LT.T1M.AND.TIM.LE.TLVD)G0  TO  890 

(1007) 

GO  TO  b 

(1008) 

890 

CONTINUE 

(1009) 

C 

IS  THE  SUBJECT  DESIRED  FOUND 

(1010) 

BLNK=*  • 

(1011) 

DO  3 1=1*21 

(1012) 

IF(SUD(I).EQ.BLNK)  GO  TO  3 

(1013) 

IF(SUB(I).NE.IT(1))  GO  TO  3 
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(1014)  IF(SUB< 1*1 ) .EQ. BUNK)  GO  TO  4 

(1015)  IF< IT(2).E0.DLNK)  CO  TO  4 

(1016)  IF(SUB(  1*1) .EQ. IT(?) ) GO  TO  4 

(.101'»)  3 CONTINUE 

(inib)  GO  TO  5 

(101°)  C SUBJECT  DESIRED  FOUND  / 

■<1020i  C increment  DOCUMENT  FOUND  COUNTER 

(1021)  4 DOC  = DOC-*l 

(1022)  C WRITE  RECOFD  FOUND  TO  TEMPORARY  FILE 

0023)  URITE(IO)HS.ATHR,DDfTO,DLN*SUB»PTtT, 

0020  1 ROUT, IODtCOUNT,CWA  .CONT, ADO. TUX*FSC»NRE 

0025)  C IS  THIS  THE  LAST  WORD  SEARCH 

0026)  IF(LOOP.FO.ICON)  GOTO  5 

0027)  C DISPLAY  SUBJECT  FOUND  ON  TERMINAL 

OC28)  WPITEO,10)SUE 

0029)  10  F0RMAT(7(1X,2A4,A2)/) 

(1030)  GO  TO 

(.1031)  C DISPLAY  NUMBER  OF  DOCUMENTS  FOUND 

(1032)  100  URITEO,1D30)DOC,(1T(I),I=1,3) 

0033)  1030  FORMAT!*  THERE  ARE*, 15,*  DOCUMENTS  CONTAINING  THE  WORD*,/ 

(1034)  17( 1X.2A4.A2 )//) 

(1035)  IF(DOC.EQ.O)  GOTO  1020 

(1CI6)  C SET  OUTPUT  FILE  TO  END  OF  FILE 

0 037)  ENDFILE  10 

0038;  C CLOSE  TEMPORARY  SEARCH  FILES 

0039)  CALL  SRCHIt(K$CLOS,*Tl*,2,0,0,0) 

(1040)  . CALL  SRCHSKKtCLOS,  *T2*,2,0,0,0> 

(1041)  C DELETE  PREVIOUS  OUTPUT  FILE 

(.1042)  IF(IC.EQ.19)  CALL  SR  CHIS  (K  tDEL  E,  ♦ T2  » , 2 , 0, 0 , 0 ) 

0043)  IF(IC.E0.20)  CALL  SR  CH  I S < K IDE  LE  , • T 1 • , 2 , 0 , 0 , 0> 

(1044)  C INCREMENT  TO  NEXT  WORD  OF  SEARCH 

(1045)  T1=T1+1 

0046)  1000  CONTINUE 

(1047)  1002  CALL  SRCHIS ( KSRDWR  + KSNDAM, *T1 * ,2,15,1 ,LC) 

0048'  CALL  SrtCHJJ (K$RnwR  + KIN0AM,*T2»  ,2,16,1,LC) 

(1 0 4 9 ) C 

(1050:.  C ARE  THERE  ANY  DOCUMENTS  FOUND 

OOM)  IF(DOC.LT.l)  GO  TO  1020  , 
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(1052)  00  9999  1=1. OOC 

(105.il  C REAO  RECORD  FOUND  DURING  SEARCH 

(1054)  READ( IO,END=1020)HS,ATHR .DP.TO .DLN.SUB.PTI T» 

(1055'  1 ROUT. lOD, COUNT, CU’A.CONT.ADD.TUX.FSC.NRE 

(1C56)  C IS  THIS  THE  FIRST  RECORD  FOUND 

(1057)  IF(IPAGE.NE.O)  GOTO  160 

(1050)  C SET  UP  FOR  DISPLAY  ON  TERMINAL 

'1C59)  1TEM=6 

(1060)  1PAGE=1 

(1061)  C DISPLAY  HEADING  FOR  SUBJECT  SEARCH  ON  TERMINAL 

(1062)  CALL  SCRNHD(ITEK) 

(1063)  C DISPLAY  DOCUMENT  RECORD  FOUND  ON  TERMINAL 

(1064)  160  CALL  SCRNPT(ITEM) 

(1065)  C IS  THIS  TOP  OF  PRINTER  PAGE 

(1066)  IF(IPRINT.NE.O)  GOTO  170 

Qj  (1067)  C PRINT  HEADING  FOR  SUBJECT  SEARCH 

^ I (lOfP)  CALL  HARDHD(ITEM) 

S3  (106V)  IPRINT  = 1 

(1070)  C PRINT  DOCUMENT.  RECORD  FOR  SUBJECT  FOUND 

(1071)  170  CALL  HARDPT(ITE.M) 

(1072)  C IS  THIS  BOTTOM  OF  PRINTER  PAGE,  YES  SET  TOP  OF  PAGE  FLAG 

(1073)  190  IF(KNT/14.EQ.KNT/14.)  IPRINT=0 

(1074)  9999  CONTINUE 

(1075)  1020  CONTINUE 

(1076)  C CLOSE  TEMPORARY  SEARCH  FILES 

(1077)  CALL  SRCH1S(KS.CL0S,  *T1»  »2,0.0.0) 

(1078)  CALL  SRCHJ$(K1CLOS,»T2».2.0.0.0) 

(1079)  C DELETE  TEMPORARY  SEARCH  FILES 

(1060)  CALL  SRCH$$ (KSDELE. ’Tl • ,2.0,n,0) 

(1081)  CALL  SRCHl$(KtDELE.*T2*.2.0.0.0) 

(1082)  T1=0 

(1083)  IREAD=0 

(1084)  IF(DOC.NE.O)  RETURN 

(1085)  1999  UHITE(1,20C0) 

(1086)  2000  FORMAT(»  DO  WISH  TO  TRY  THE  SUBJECT  SEARCH  AGAIN  (YES  OR  NO)») 

(1087)  READ(1,2001,CRR=1999)IOPT 

■ (1068)  2001  F0RMAT(1A2) 

(1  089)  IFdOPT.EO.*  YE»)  GOTO  1001 
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(1090)  IF( lOPT.NE.’NO*)  GOTO  1999 

<1091>  RETURN 

(1092)  END 
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ADO 

1 

/bLk/ 

000163 

0917S 

0997H 

1023 

1054H 

ATHR 

J 

/BLK/ 

000001 

0917S 

C997H 

1023 

1054H 

BLNK 

J 

001706 

0919S 

1 0 1 0 n 

1012, 

1014 

CLEAR 

R 

EXTERNAL 

000000 

0937 

CON 

J 

/BLK/ 

002731 

C917.S 

CONT 

J 

/BLK/ 

000151 

0917S 

099'7M 

1023 

1054M 

COUNT 

J 

/BLK/ 

002727 

0917S 

0997H 

1023 

1054M 

CHA 

I 

/BLK/ 

000145 

C917S 

0997H 

1023 

1054H 

0 

I 

/SRC/ 

000136 

0917S 

OA 

J 

/SRC/ 

000003 

0917S 

OD 

I 

/ELK/ 

000017 

0917S 

0997H 

1023 

1054H 

ODD 

I 

/SRC/ 

000021 

0917S 

DDT 

J 

/ELK/ 

000304 

0917S 

DL 

J 

/SRC/ 

000044 

0917S 

PLN 

0 

/r-LK/ 

000042 

0917S 

0997M 

1023 

1054M 

DM 

I 

/SRC/ 

000002 

0917S 

CP 

DOC 

I 

001710 

091PS 

0984H 

1 021M 

1032 

1 

00 

DRi: 

/SRC/ 

10E4 

J 

000171 

0917S 

DT 

J 

/SRC/ 

000157 

0917S 

DTJ 

D 

000000 

0917S 

DTO 

J 

/SRC/ 

000024 

0917S 

DU 

J 

/SRC/ 

000145 

0917S 

FSC 

J 

/BLK/ 

000262 

0917S 

0997M 

1023 

1054H 

FVD 

•I 

/SRC/ 

000203 

0917S 

HARDHD 

R 

EXTERNAL 

000000 

1068 

HAPCPT 

R 

EXTERNAL 

000000 

1071 

I 

I 

001711 

0931  M 

0933 

0955M 

0956 

1014 

1016 

1032M 

1052M 

lANM 

1 

/FLA/ 

000003 

0917S 

0967 

IC 

I 

C01713 

0961  A 

0962A 

ICON 

I 

C01714 

0918S 

0941H 

0944 

0945 

ID 

I 

001715 

lOOlH 

1004A 

I DO 

I 

/ELK/ 

000142 

0917S 

0997M 

1000 

1001 

lEX 

J 

/SRC/ 

000211 

0917S 

0933H 

0956M 

IH 

I 

001716 

1 0 0 tl  M 

1 004A 

IHFLE 

I 

/FLA/ 

000001 

0917S 

0965 

IMIS 

I 

/FLA/ 

000005 

0917S 

0969 

PACE  0087 


lOlS 


1035  1051  10.52 


lOllH  1012  1013 

I 

0946  . 1026 

1002'  1023  1054M 
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IN 

1 

001717 

0918S 

0973H 

0975H 

0977H 

0979H 

0997 

10 

I 

001720 

0918S 

0974H 

0976H 

0978  K 

0980M 

1023 

1037 

1042 

1043 

1054  . 

lOPT 

I 

001721 

0920S 

10R7M 

1 089 

1090 

IPAGE 

I 

001722 

0920S 

09  2 5M 

1057 

1060H 

IPR 

I 

/FLA/  OOOOOA 

0917S 

0968 

I PR  I NT 

I 

001723 

0920S 

0927M 

1066 

1069K 

1073H 

IREAO 

I 
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T109A)  C THIS  SUBROUTINP.  PERFOkHS  THE  ACTION  DUE  DATE  SEARCH 

flUSB)  C HATCHES  OATES  WITHIN  5 DAYS  OF  THE  SELECTED  DATE  OR  PAST  DUE 

PI096>  C 

(1C96)  C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

(1096)  C 

(1096)  COMMON/BLK/  MS, ATHR ,DD,TO,OLN,SUB»ROUT«lnD»CUA »C0NT» 

(1096)  1 ADO, TUX.FSC,NPEtOOT,R,PTIT*COUNT,CON 

(1096)  COMHON/SRC/  KNT ,DM , DA , ODD , DTO , DL , I T , D, W A ,DU , DT ,DRE 

(1096)  1 ,TFVO,TLVD,FVP,LVD,IEX 

(1096)  ■ COHHON/FLA/  I T RSP , I MELE , I TUFX , I ANN , IP R , IM I S , I R E AD 

..(1096)  INTEGER*^  A T HR  ( 7)  , TO(  P ) , DLN  ( b ) , SUB  ( ? 1 ) , R OUT  ( 6 ) ,PT  IT  < 1 9 ) , 

(1096)  1 C0N(5),TUX(6,5),FSC(f>),NRE(l,3)»0DT(30,21),T(21) 

(1096)  1 ,TIT(2A) ,C0UNT,C0NT(5),IEX(9,3) 

(1  096)  INTEGER*2  MS , DD ( 3 ) , I DD ( 3 ) , ADD ( 3 ) ,R ,C WA ( 9 ) , WA ( A ) 

(1096)  INTEGER*2  I TRSP , I MELE , I TUFX , I ANN  , I PR  , IH  I S, I READ 

(1096)  INTEGER*2  F VD ( 3 ) , LVD ( 3) , D ( 3) , DM , ODD ( 3) 

(109C-)  INTEGER'A  D P E , DT  ( 5 ) , DU  ( 5 ) , DL(  5 ) , D A ( 7 ) , I T(2  A ) , DTO  ( P)  » KNT 

(1096)  DOUBLE  PRECISION  DT J , TK , TL , T JUL , TF VD, TL VD, TI H, T J 

(1097)  C SYSCO«>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(1097)  NOLIST 

(10'98)  INTEGER*2  IH,r0,IY,M,D,Y,ICURR(3),IACT(3),I0IFF(3) 

(1099)  INTEGER*2  I P AGE  , I PR INT , I OP T 

(1100)  DOUBLE  PRECISIO!.'  DTJ 

(lion  C INITIALIZE  THE  FOUND  COUNTER 

(1102)  KNT=0 

(1103)  C INITIALIZE  THE  FIRST  F.OUND  FLAG 

mOA)  IPAGE  = 0 

(1106)  C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

(1106)  IPRINT=0 

(1107)  WRITE(1,1) 

(1108)  1 FORM.AK*  THIS  IS  THE  ACTION  ITEM  DUE  DATE  ROUTINE*,/, 

(1109)  1*  NOTE  - THE  BREAK  KEY  HAS  BEEN  DISABLED  FOR  THIS  RUN*,/) 

(1110)  5 WRITE! 1,10) 

(.lin  10  FORMAT (IX, ‘THERE  ARE  TWO  (?)  OPTIONS  FOR  THE  ACTION  DUE  SEARCH*,/, 
(1U2)  111X,*1.  A COMPLETE  LISTING  OF  ALL  ACTION  DUE  (1)* 

(1113)  1,/,11X,*2.  A NORMAL  WITHIN  6 DAYS  OR  PAST  DUE  (2)*/) 

(lllA)  READ(1,15,ERR=5)  lOPT 


- 1 - , • ■ . . * > 


SUBROUTINr  ADAT 


PAGE  0093 


(1115) 
(111^.) 
nil7> 
(1118) 
(1119) 
(1120) 
*1121 ) 
(1122) 
(1123) 
(112A) 
(1125) 
(1126) 
(1127) 
(1128) 
(1129) 
(113U) 
(li31> 
(1132) 
'f  (i:33) 

v£>  (113A) 

Q (1135: 

(1136) 
{ 1 : 3 7 ) 
(1138) 
(1139) 
(llAO) 
(HAD 
(11A2) 
(11A3) 
(llAA) 
(11A5) 
(1) A6) 
(11A7) 
(11A8) 
(11A9) 
(1150) 
(1151) 
(1152) 


15  F0RMAT(I2) 

1F(I0PT.LE.0.0R.I0PT.GE.3)  GOTO  5 
C DISABLE  THE  BREAK  KEY 

CALL  BREAKt(.TRUE.) 

C POSITION  THE  DATE  FILE  TO  THE  BEGINNING  OF  FILE 

RLU'INO  10 

READ(10,llll)IK,IDfIY 
nil  F0RHAT(1X,3I2) 

REWIND  10 

C CONVERT  THF  CURRENT  DATE  TO  TREK  TIME 

ICURR(D  = IY 
ICURR(2)=IH 
ICURR(3)=ID 

CALL  SRCH1$(K$RDUR+K$NDAH,»ACTD  •*6,5«1»IC) 

PEUINO  9 

100  READ(9iENO=200)  ATHR , DLN»PT I T,IDD tCOUNT » ADD *FSC t NRE 

IF(IOPT.EQ.l)  GOTO  150 
C 

C STORE  THE  ACTION  DUE  DATE 

99  1M=ADD(1) 

ID=ADD(2) 

IY=ADD(3) 

C IS  THIS  DATE  A LEGAL  ACTION  DUE  DATE 

IF(IH.Er..O.AND.ID.EQ.O.AND.IY.E(J.O)  GO  TO  100 
G CONVERT  THE  ACTION  DUE  DATE  TO  TREK' TIME 

IACT(1)=1Y 
IACT(2)=IH 
IACT(3)=ID 

C CALCULATE  THE  DIFFERENCE  BETWEEN  THE  SELECTED  DATE  AND 

C THE  ACTION  DUE  DATE  , 

IDIFF (1 )=IACT( 1 )-ICURR ( 1 ) 

IDIFF {2)=IACT(2)-ICURR (2) 

IDIFF(3)=IACT(3)-ICURR(3) 

C IS  THIS  DIFFERENCE  WITHIN  THE  5 DAY  OR  PAST  DUt  TIME  FRAME 

IF(IDIFF(D .GT.0.0R.IDIFF(2).GT.l)  GOTO  100 

IF(IDIFFd)  .EQ.O.A,ND.IDlFF(?).EO.O.AND.IDIFF(3).CE.f.)  GOTO  100 
1F(IDIFF(1).FQ.C.a:.D.IDIFF(2).EQ.1.AND.IDIFF(3).CE.O)  goto  100 
IF(IDIFFd)  .E0.C.AND.IDIFF(2)  .EO.l)  GOTO  500 
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(1153)  C AN  ACTION  DUET  DATE!  WAS  FOUND  AND  MATCHED 

(1154)  t IS  THIS  THE  FIRST  DOCUMENT  FOUND  WITHIN  THE  TIME  FRAME 

(1155)  150  IF(IPAGE.NE.O)  GOTO  160 

(1156)  C SET  UP  FOR  DISPLAY  OF  DOCUMENT 

(1157)  ITEH=11 

(1159)  IPAGE=1 

(1159)  C DISPL«Y  HEADING  ON  TERMINAL  FOR  ACTION  DUE 

(1160)  CALL  SrRNHD(ITFM) 

(1161)  C DISPLAY  THF  DOCUMENT  RECORD  FOUND 

(1162)  160  CALL  SCRNPT(ITLM) 

(1163)  WRITE (1»2000)  ATHR,NPE»ADD 

(1164)  2000  FORMAT{3Xi7A4»2X.3(A3»lX),7X»2(I2«*-*)»I2) 

(1163)  C IS  THIS  A NEW  PAGE  ON  PRINTER 

(1166)  IF (IPRINT .NE.O  ) GOTO  170 

(1167)  C PRINT  HEADING  ON  PRINTER  FOR  ACTION  DUE 

(1168)  CALL  HAKDHD(ITEM) 

(1169)  C PRINT  RECORD  OF  DOCUMENT  FOUND  FOR  ACTION 

. — I (1170)  IPRINT=1 

(1171)  170  CALL  HARDPT(ITEM) 

CA  (1172)  WRITE  ( 7,2001  ) AT  HR , r.RE , ADD 

(1173)  2001  F0RMAT(6X,7A4,A8X,3(A3,1X) ,29X,3I2) 

(117‘.)  C IS  THIS  THE  BOTTOM  OF  PRINTER  PAGE,  YES  SET  TOP  OF  PAGE  FLAG 

(1175)  IF(KNT/14.EO.KNT/14.)  IPR1NT=0 

(117b?  GO  TO  100 

(1177!  C 

(1178)  C CHECK  FOR  VALID  ACTION  DATE  CONTINUED  FOR  SPECIAL  MONTH  VALUES 

(1179)  C SET  FOR  A 31  DAY  MONTH 

(1100)  C 

(i:ei)  500  IDIFF(3)=ID1FF(3)*31 

(1182)  C IS  THIS  A 30  DAY  MONTH,  YES  DEDUCT  ONE  DAY 

(118  3)  IF(ICURR(2) .LG . 4. OR . I CURR ( 2 ) .E 0. 6 . OR . I CURR  ( 2 ) . FQ .9. OR . ICUR R ( 2 ) 

(1184)  1 .EC. 11)  IDIFF(3)=IDIFF(3)-1 

(1185)  C IS  THIS  THE  MONTH  OF  FERURARY 

(1186)  IF(1CURR(2).NE.2)  GOTO  550 

(1187)  C IS  THIS  A LEAP  YEAR,  YES  DEDUCT  TWO  (2)  DAYS 

(1188)  C NO  DEDUCT  THREE  (3)  DAYS 

(1189)  lF(ICURR(l)/4.NE.lCURR(l)/4.)  I DI FF ( 3 ) =I DI FF ( 3 ) -1 

(1190)  IDIFF(3)=I01FF(3)-2 
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(1191)  C IS  THIS  ACTION  DATE  WITHIN  5 DAYS  DUE 

U192>  550  1F(10IFE(3).GE.6)  GOTO  100 

tll93)  GO  TO  150 

(119-*)  C CLOSE  THE  ACTION  DUE  SUBFILE 

(1195)  200  CALL  SRCH t J ( K$ CLOS * * ACTD  *»6t0»0t0> 

(1196)  C WERE  THERE  ANY  ACTION  DUE  DOCUMENTS  FOUND 

(1197)  IF(KNT.rO.O)  GO  TO  300 

(1198)  URITE(ltAOO) 

(1199)  AOO  FORHAK*  •/> 

(1200)  C DISPLAY  THE  NUMBER  OF  DOCUMENTS  FOUNO 

(1201)  ■ URITEd.PODKNT 

(1202)  201  FORMAT!*  THERE  AR E ♦ 1 1 0 » DOCUMENTS  AWAITING  ACTION*/) 

(1203)  C CLOSE  ALL  OPEN  WORKING  FILES 

(12CA)  202  CALL  SR CH J I ( KTCLOS ♦ • OUT  *t6,0»0»0) 

(1205)  CALL  SRCHiS (KlCLOSf *DATE  **6t0.0,0) 

OJ  (1206)  CALL  SRCHSS(KSCLCS,»REVS  *,6*0, 0*0) 

^ (1207)  C SPOOL  THE  OUTPUT  FILE  TO  THE  PRINTER  FOR  HARO  COPY 

•'J  (1208)  CALL  C0MIiS(*S0UT*,A,12,lC) 

(1205)  CALL  EXIT 

(1210)  C DISPLAY  A NO  DOCUMENT  FOUND  MESSAGE 

(1211)  300  WRITE(1,301) 

(1212)  301  FORMAT!*  THERE  ARE  NO  DOCUMENTS  AWAITING  ACTION*/) 

(1213)  RETURN 

(121A)  END 
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KlHENT 

I 

OOOOOO 

1097S 

KSMSI7 

I 

PARAMETER 

1097S 

KSMVNT 

I 

PARAMETER 

1097S 

KJNDAM 

I 

PARAMETER 

1097S 

1128 

KSNHTN 

I 

P ARAMETER 

1097S 

KSNSAH 

I 

PARAMETER 

1097S 

KSNSGC 

I 

PARAMETER 

1097S 

KiNSGS 

I 

PARAMETER 

1097S 

B-lOi 
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KJ(>OSA 

i 

Parameter 

1097S 

K5PUSN 

I 

PARAMETER 

1097S 

K JPOSR 

I 

PARAMETER 

1097S 

KiPREA 

I 

PARAMETER 

1097S 

KSPRER 

I 

PARAMETER 

1097S 

KSFROT 

I 

PARAMETER 

1097S 

KSRDUR 

I 

PARAMETER 

1097S 

1128 

KSREAD 

I 

PARAMETER 

1097S 

KSRPOS 

I 

PARAMETER 

1097S 

K$RSUE 

I 

PARAMETER 

1097S 

ksrulk' 

I 

PARAMETER 

1097S 

KIEENT 

I 

000000 

1097S 

KISETC 

I 

PARAMETER 

1097S 

KSSETH 

I 

PARAMETER 

1097S 

KISPOS 

I 

PARAMETER 

1097S 

KJSPTN 

I 

PARAMETER 

1097E 

KiTPNC 

I 

PARAMETER 

1097S 

KJUPCS 

I 

PARAMETER 

1097S 

KSWRIT 

I 

PARAMETER 

1097S 

KNI 

j 

/SRC/  000000 

1096S 

X102H 

1175 

1197 

LVD 

I 

/SRC/  000206 

10  96S 

H 

I 

GOOOGO 

109PS 

MS 

I 

/()LK/  000000 

109fS 

NRE 

j 

/ELK/  000276 

1096S 

1130H 

1163 

1172 

PTIT 

v) 

/RLK/  002661 

1096S 

1130H 

R 

I 

/ELK/  002660 

10  9f  S 

ROUT 

J 

/ELK/  000126 

1056  S 

SCRNHD 

R 

EXTERNAL  OOOOOO 

. 1160 

SCRNPT 

R 

EXTERNAL  000000 

1162 

SRChJS 

R 

EXTERNAL  000000 

1120 

1195 

120A 

1205 

SUB 

J 

/BLK/  0C005A 

1096S 

f 

J 

000013 

1096S 

TP 

0 

OOOOOO 

1096S 

TFVD 

D 

/SRC/  000173 

1096S 

TIM 

D 

COOCOO 

105f  S 

TIT 

J 

000065 

109E>S 

TJ 

D 

000000 

1096S 

TJUL 

D 

OOOOOO 

1096S 

) 
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VTL 

0 

000000 

1096S 

TLVD 

0 

/SRC/ 

000177 

1096S 

TO 

J 

/BLK/ 

000022 

1096S 

TUX 

J 

/I'LK/ 

000160 

10  96S 

UA 

1 

/SRC/ 

OOOHl 

1096S 

Y 

I 

000000 

109f'S 

_1 

000164 

1107 

110(30 

Iio 

000255 

1110 

11110 

_100 

000511 

11300 

113fl 

_1111 

000453 

1121 

11220 

DC041 3 

1114 

11150 

”l50 

000677 

1131 

11550 

~16C 

000713 

1155 

11620 

CO 

_170 

000765 

1166 

11710 

_200 

001154 

1130 

11950 

o 

_2000 

_2061 

000732 

CC1C05 

1163 

1172 

11640 

11730 

_2  01 

001213 

1201 

12020 

_202 

001243 

1204D 

_300 

001302 

1197 

12110 

_301 

001306 

1211 

12120 

_A00 

001200 

1196 

11990 

_5 

000251 

lllDD 

1114 

500 

001054 

1152 

IICIO 

_b50 

001147 

1166 

11920 

_99 

000553 

1134D 
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(1215) 

(121f)  C 

(121 7>  C 

(1217>  C 

.1217)  C 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 

(1217) 


(121V) 

(1217) 

(1217) 

(1218) 

(1219) 

C 

(1220) 

(1221) 

C 

(1222) 

(1223) 

C 

(122A) 

(1225) 

(1226) 

11 

(1227) 

(1228) 

(1229) 

22 

(123  0 ) 

C 

(1231) 

100 

(1232) 

c 

(1233) 

(123A) 

c 

(1235) 

c 

(1236) 

c 

(1237) 

SUBROUTINE  DATC 

THIS  SUBROUTINE  PERFORMS  THE  INPUT  DOCUMENT  DATE  SEARCH 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

COMMON /BLK/  MS t ATHR ,00 *TO *OLN , SUB t ROUT , I DO f CWA .CONT, 

1 AOD«TUX,FSC,NRE,DCT,R,PTIT,COUNT»CON 

COMMON /SRC/  KNT,DH,DA*P0D»DT0»DL,IT,0»WA»DU»DT,DRE 
1 , TFVD ,TLVU*FVD.LVO,  IE  X 

COMMON/ FLA/  I T RSP  , I MELT  » I TU'FX  1 1 ANN  » IPR  , IM I S * I R EAD 
INTEGER -A  A THR < 7) , T 0 ( 8 ) , ULN ( 5 ) t SUB ( 2 1 ) »R OUT ( 6) ,PT I T ( 1 9 ) ♦ 

1 CON  ( 5 ) t TU  X ( fc  , 5 ) ,F  SC  ( 8 ) , NR  r ( 1 » 7. ) , DDT  ( 30 , 2 1 ) ♦ T ( 2 1 ) 

1 , TIT (2A) , COUNT fC0NT(5 ) «nX(At3) 

INTEGER  *2  MS  , OD  ( 3 ) f I CD  ( 3 ) » ADD  ( 3 ) » R «CW  A ( A ) , L'A  ( A ) 

INTEGER*2  I T RSP , I Ml LE * I TUFX , I A NN 1 1 PR  * 1 M I S, I RE AD 
INTEGER*2  F VD ( 3 ) , L V P ( 3 ) . D ( 3) » DM , DDD ( 3 ) 

INTFGER»A  D RF , DT ( 5 ) , DU ( 5 ) , DL ( 5 ) , D A ( 7 ) » I T ( 2 A ) , DT 0 ( 6 ) «KNT 
DOUBLE  PRECISION  D TU » T F« TL , T JUL, TF VO » TL VDi T I M » T J 
INTEGER*2  IPAGEtIPRINT 
INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

INITIALIZE  THE  FIRST  FOUND  FLAG 
IPAGE=n 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPRINT=0 
WRlTE(l.ll) 

FORMAT!*  INPUT  DATA  DATE  SEARCH  ROUTINE  »*/♦ 

1*  UHAT  IS  THE  DATE  THAT  YOU  U ANT  * * / * • MMDDYY*/) 
READ(1.22,ERR=11)D 
F0RMAT(3I2) 

READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 
CALL  RDSUB 

IS  THE  SEARCH . COMPLETED  ON  ALL  SELECTED  SUDrFILES 
IF(IREAO.EC.l)  GOTO  200 

■ FIND  THE  DESIRED  INPUT  DATE  OR  DATES 

IF(D(l).EQ.O  .OR.  D(l)  .EQ.IDD(D)  GOTO  110 


r 


) 


) 
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03 


(1238) 

GO  TO  100 

(1235) 

(1250 

110 

1F(D(2).EQ.0  .OR.  D ( 2 ) .E 0. IDD ( 2 ) ) 
GO  TO  100 

GOTO 

120 

(1251) 

(1252) 

120 

IF(D(3).EQ.O  .OR.  D ( 3) .EQ . IDD ( 3 ) ) 
GO  TO  100 

GOTO 

150 

<12A3)  C AN  INPUT  DATE  UAS  FOUND  AND  MATCHED 

(12AA)  C IS  THIS  THE  FIRST  RECORD  FOUND 

<12A5)  150  IF(IPAGE.NE.O)  GOTO  160 

{12A6)  C SET  UP  FOR  THE  RECORD  DISPLAY 

(12A7)  ITEM=8 

(12A8)  ■ IPAGE=1 

(12A<))  C DISPLAY  HEADING  FOR  INPUT  DATE  ON  THE  TERMINAL 

(1250)  CALL  SCRNHD(ITEK) 

(1251)  C DISPLAY  THE  RECORD  FOUND  ON  THE  USER  TERMINAL 

11252)  160  CALL  SCRNPT(ITEM) 

<1253:  C IS  THIS  THE  TOP  OF  PRINTER  PAGE 

(125A:  IF(IPRINT.NF.O)  goto  170  . 

C1255)  C PRINT  HEADING  FOR  INPUT  DATE  ON  PRINTER 

(1.756)  CALL  HARDHD(ITFK) 

(1257)  IPRINT=1 

(1256)  C PRINT  RECORD  FOUND  ON  PRINTER 

(1259)  170  CALL  HARDPT(ITEM) 

(1260)  C IS  THIS  BOTTOM  OF  PRINTER  PAGE*  YES  SET  TOP  OF  PAGE  FLAG 

(1261)  190  IF(KNT/1A.E0.KNT/1A.)  IPRINT=0 

(1262)  GO  TO  100 

(1263)  C DISPLAY  THE  NUMBER  OF  DOCUMENTS  FOUND 

(1261)  200  URITE(1»300) 

(1265)  300  FCRMAK*  •/) 

(12b'j)  URITE(lf250)KNT.D 

(1267)  250  FORMAT!*  THERE  ARE  *19*  DOCUMENTS  WITH  A DATE  OF  *2 ( 12 • -• ) » 12 ) 

(1268)  RETURN 

(1269)  END 
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ADO 

1 

/DLk/ 

000163 

1217S 

ATHR 

J 

/f;LK/ 

OOCOOl 

1217E 

CON 

J 

/FLK/ 

002731 

1217S 

CONT 

J 

/BLK/ 

000151 

1217S 

COUNT 

J 

/BLK/ 

002727 

1217S 

CUA 

I 

/ELK/ 

0 001A5 

1217S 

D 

I 

/SRC/ 

000136 

1217S 

1228M 

1237 

1239 

DA 

J 

/SRC/ 

0 00  00  3 

1217S 

DATC 

R 

OOOOCO 

121FS 

OD 

I 

/PLK/ 

000017 

1217S 

DDO 

I 

/SRC/ 

000021 

121  7S 

DDT 

J 

/FLK/ 

00030^ 

1217S 

DL 

J 

/SRC/ 

OOOCAA 

1217S 

DLN 

J 

/FLK/ 

OOOOA2 

1217S 

DM 

I 

/SRC/ 

000002 

1217S 

DRE 

J 

/SRC/ 

000171 

1217S 

DT 

J 

/SRC/ 

000157 

1217S 

DTJ 

D 

000000 

1217S 

DTO 

J 

/SRC/ 

000024 

121  7S 

DU 

J 

/SRC/ 

000145 

1217S 

FSC 

U 

/ELK/ 

000262 

1217S 

FVD 

I 

/SRC/ 

000203 

1217S 

HARDHD 

R 

EXTERNAL 

OOOOCO 

1256 

HARDPT 

R 

EXTERNAL 

000000 

1255 

I ANN 

•I 

/FLA/ 

00G003 

1217S 

IDD 

I 

/FLK/ 

000142 

1217S 

1237 

1239 

1241 

lEX 

J 

/SRC/ 

000211 

1217S 

IHELE 

1 

/FLA/ 

000001 

1217S 

IMIS 

I 

/FLA/ 

000005 

1217S 

IPAGE 

I 

000466 

1216S 

1222H 

1245 

1248M 

IPR 

I 

/FLA/ 

000004 

1217S 

IPRINT 

I 

000457 

1216S 

1224M 

1254 

1257H 

IREAO 

I 

/FLA/ 

000006 

1217S 

1233 

IT 

J 

/SRC/ 

000056 

1217S 

ITEM 

I 

000460 

1247M 

1250A 

1252A 

1256A 

I IRSP 

I 

/FLA/ 

000000 

1217S 

ITUFX 

I 

/FLA/ 

000002  . 

1217S 

KNT 

J 

/SRC/ 

000000 

1217S 

I220M 

1261 

1266 

) 
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1261H  . 
1259A 
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LVU 

I 

/SRC/ 

000206 

1217S 

MS 

I 

/BLK/ 

000000 

1217S 

NRE 

J 

/BLK/ 

000276 

1217S 

PTIT 

J 

/BLK/ 

002661 

1217S 

R 

1 

/BLK/ 

002660 

1217S 

ROSUB 

R 

EXTERNAL 

000000 

1231 

ROUT 

J 

/ELK/ 

000126 

12176 

SCRNHD 

R 

EXTERNAL 

000000 

1250 

SCRNPT 

R 

EXTERNAL 

COOOOO 

1252 

SUB 

J 

/BLK/ 

00005A 

1217S 

T 

J 

Q0C002 

1217S 

TF 

0 

000000 

1217S 

TFVD 

D 

/SRC/ 

000175 

1217S 

TIM 

0 

COOOOO 

1217S 

TIT 

J 

00005A 

1217S 

TJ 

D 

000000 

1217S 

TJUL 

D 

ooooo'o 

1217S 

TL 

0 

000000 

1217S 

TLVb 

b 

/SRC/ 

000177 

1217S 

TO 

J 

/BLK/ 

000022 

1217S 

TWX 

J 

/FLK/ 

000166 

1217S 

UA 

I 

/SRC/ 

OOOlAl 

1217S 

100 

0002R5 

1231D 

1238 

1240 

1242 

11 

000153 

1225 

1226D 

1228 

IllO 

000267 

1237 

12390 

120 

000304 

1239 

1241D 

_lbO 

000321 

1241 

1245D 

_160 

000334 

1245 

1252D 

_170 

000345 

1254 

12590 

_190 

000347 

1261D 

~2C0 

000375 

1233 

12640 

"22 

000237 

1228 

12290 

_25C 

000417 

1266 

12670 

_3  0 0 

000401 

1264 

12650 

1262 
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(1270) 

(1271) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 

(1272) 


cn 


(1273) 
.1272) 
(1272) 
(1272) 
(1272) 
(1272) 
(1273) 
(127A  ) 
(1275) 
(127£.) 
(1277) 
(1278) 
(1279) 
(1280 
(1281) 
(1282? 
(1283) 

(126't) 


(1285) 

(1286) 

(1287) 

(1288) 

(1269) 

(1290) 

(1291) 

(1292) 


SUBROUTINE  DDAT 

C THIS  SUBROUTINE  PERFORMS  THE  DOCUMENT  DATE  SEARCH 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

COMMON /BLK/  MS , ATHR  t DD » TO . OLN , SUB* ROUT » I 00 « CWA  tCONT* 

1 ADOtTUX,FSC,NKr.DOT,R.PTIT,COUNT*COM 

COHHON/SRC/  KNT*DM,DA*OnD*DTO,nL*IT*D»UA,DU«DT«DRE 
1 .TFVt)iTLVD«FVD,LVD»IEX 

COKMON/FLA/  ITRSP,  IMELEt  IT'.IFX,IANN*IPR,IHIS*IREAD 
INTEGER*^  ATHP ( 7) ,T0(8), 0LN(5) .SUB(21 ) *R0UT(6) ,PTIT(19) » 

1 CCN(5)»TUX(6*5) * FSC ( 6 ) , NR L ( 1 , 3 ) * DDT ( 30 *21 ) »T ( 21 ) 

1 *TI T (2A) *COUNT*CONT(b)  *I E X( A*3) 

INTEGER*2  MS  * DD ( 3 ) * IDD ( 3 ) * ADD ( 3 ) * H * C WA ( A ) * U A ( A ) 

INTEGER *2  ITRSr*IMELE* I T VFX * I ANN  * I PR  * I M IS  * I R E AO 
INTEGER»2  F VD ( 3 ) * L V i; ( 3 ) * D ( 3)  * 0".* DOO  ( 3 ) 

INTEGER  *A  DRE*DT(5)*m.'(5)*DL(5)*DA(7)*IT(2A)*DT0(8)*KNT 
DOUBLE  PRECISION  DT J , TF * TL * TJUL * TF VP , TL VD* T I M* T J 
INTEGER*2  IPAGE*IPRINT 
C INITIALIZE  FOUND  COUNTER 

KNT=0 

C INITIALIZE  THE  FIRST  FOUND  FLAG 

IPAGE=0 

C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

IPRINT=0 
URITE(1*11) 

11  FOBHAT(»  DOCUMENT  DATE  SEARCH  ROUTINE  •*/* 

1»  UHAT  IS  THE  DATE  THAT  YOU  U ANT • * /* »HMODY Y» /) 
READ(1*22*ERR=11)DD0 
22  F0RMAT(3I2) 

C READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE 

100  CALL  RDSUa 

C IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 

IF(IREAD.EC.l)  GOTO  200 
IF(DDDd)  .EO.O  .OR.  ODD  ( 1 ) .EQ  .00  ( 1 ) ) GOTO  110 
GO  TO  ICO 

110  IF(DCD(2) .E3.0  .OR.  DDD ( 2 ) .EQ . DD ( 2 ) ) GOTO  120 
GO  TO  ICO 


■I  t t 1 
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(1293) 

(1294) 

(1295> 

(1296) 

(1297: 

(129ft: 

;i299) 

(1300) 

(1301) 

(1302) 

(1303) 

(130<() 

(1305) 

(1300) 

(1307) 

(1305) 

(1309/ 

(1310) 

(1311) 

(1312) 

(1313) 

(131A) 

(1313) 

(1316) 

(1317) 

(1313) 

(1319) 

(1320) 

(1321) 


l2d  1F(DDD(3).EQ.0  .OR.  ODD (3 ) .EG . DO ( 3 ) ) GOTO  150 
GO  TO  100 

C IS  THIS  THE  FIRST  RECORD  FOUND 

150  IF(IPAGE.NE.O)  GOTO  160 
C SET  UP  FOR  HEADING  DISPLAY 

ITEH=3 
IPAGE-1 

C DISPLAY  HEADING  FOR  DOCUMENT  DATE  ON  USER  TERMINAL 

CALL  SCRNHDdTEM) 

C DISPLAY  RECORD. FOUND  ON  USER  TERMINAL  SCREEN 

160  CALL  SCRNPT(ITFM)‘ 

C IS  THIS  FOR  TOP  OF  PRINTFR  PAGE 

IF(  IPRINT.NE.O)  GOTO  170 

C PRINT  HEADING  FOP.  DOCUMENT  DATE  ON  PRINTER 

CALL  HAP.DHD  (I  TEM) 

IPRINT=1 

C PRINT  RECORD  FOUND  ON  PRINTER 

170  CALL  HARDPT(ITEM) 

C . IS  THIS  POTTOH  OF  PRINTER  PAGE.  YES  SET  TOP  OF  PRINTER  PAGE  FLAG 
190  IF(KNT/1A.EQ.KNT/1A.)  1PRINT=0 
GO  TO  100 

C DISPLAY  THF  NUMBER  OF  DOCUMENTS  FOUND 

200  URITE(1,300) 

300  FORMAT(»  •/) 

URITE( 1.2501KNT.DDD 

250  FCRMAT(»  THERE  ARE  »I9»  DOCUMENTS  WITH  A DOCUMENT  DATE  OF  ♦2(I2» 

1 *-*)»I2/) 

RETURN 

END 
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ADD 

I 

/PLK/ 

000163 

1272S 

ATHR 

J 

/feLK/ 

000001 

1272S 

CON 

J 

/ELK/ 

002731 

1272S 

CONI 

J 

/ELK/ 

000151 

12725. 

COUNT 

J 

/ELK/ 

002727 

I27pr. 

CUA 

I 

/bLK/ 

0C01A5 

1272S 

0 

I 

/SRC/ 

000136 

1272S 

OA 

J 

/SRC/ 

000003 

1272S 

DO 

I 

/ELK/ 

000017 

1272S 

1289 

1291 

1293 

ODAT 

R 

000000 

127CS 

ODD 

I 

/SRC/ 

000021 

1272S 

1283M 

1289 

1291 

1293 

DDT 

J 

/ELK/ 

00030  A 

12  725 

DL 

J 

/SRC/ 

OOOOAA 

12  72S 

DLN 

J 

/ELK/ 

OOC042 

1272S 

. 

DM 

I 

/SRC/ 

000002 

1272S 

ORE 

J 

/SRC/ 

000171 

1272S 

DT 

J 

/SRC/ 

000157 

1272S 

DTJ 

D 

000000 

127PS 

OTO 

J 

/SRC/ 

00002A 

1272S 

CU 

J 

/SRC/ 

G001A5 

1272S 

FSC 

J 

/ELK/ 

000262 

1272S 

FVD 

I 

/SRC/ 

000203 

1272S 

HARDHD 

R 

EXTERNAL 

000000 

' 1307 

hAROPT 

R 

EXTERNAL 

000000 

1310 

lANN 

1 

/FLA/ 

000003 

1272S 

IDD 

I 

/ELK/ 

0001A2 

12725 

IF.X 

J 

/SRC/ 

000211 

1272S 

IKtLE 

I 

/FLA/ 

000001 

1272S 

IF.IS 

I 

/FLA/ 

000005 

12  72S 

IPAGE 

I 

000463 

1273S 

1277M 

1296 

1299H 

IPR 

I 

/FLA/, 

ODOOOA 

1272S 

IPRINT 

I 

000464 

1273S 

1279H 

1305 

1308H 

1312H 

IREAD 

I 

/FLA/ 

000006 

1272S 

1288 

IT 

J 

/SRC/ 

000056 

1272S 

ITEM 

I 

000465 

12  9EK 

1301  A 

1303  A 

1307A 

1310A 

ITRSP 

I 

/FLA/ 

000000 

1272S 

ITUFX 

I 

/FLA/ 

000002 

1272S 

KM 

J 

/SRC/ 

000000 

1272S 

1275M 

1312 

1317 

1317  . 
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LVD 

1 

/SRC/ 

000206 

12  72S 

MS 

I 

/BLK/ 

000000 

1272S 

IMRE 

J 

/BLK/ 

000276 

1272S 

PTIT 

J 

/ILK/ 

D02661  . 

1272S 

R 

I 

/BLK/ 

002660 

1272S 

RDSU0 

R 

EXTERNAL 

nooooo 

1286 

ROUT 

d 

/l;lk/ 

000126 

12  72  6, 

SCRNHD 

R 

EXTERNAL 

cooooo 

1301 

SCR^PT 

R 

EXTERNAL 

c 0 0 0 0 n 

1303 

SU6 

J 

/LLK/ 

OOOOSA 

12  72S 

T 

■ J 

000002 

12  7?  R 

TF 

0 

000000 

12  72S 

TFVD 

0 

/SRC/ 

0C0173 

12  72E 

TIM 

Cl 

000000 

1272S 

TIT 

J 

00005A 

1272S 

TJ 
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SUBROUTINE  WHO 

C THIS  SUBROUTINE  PERFORMS  THE  SEARCH  FOR  WHO  THE 

C DOCUMENT  WAS  SENT  TO.  THE  ADDRESSEE. 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

common/blk/  ms, ATHR,DD,T0,0LN,KUD.R0UT»IDD,CWA.C0NT« 

1 ADD. TWX.FSC.NPE.ODT.R.PTIT.COUNT.CON 

COMMON/SRC/  KNT,DH,DA.CD0.DT0,0L,IT.D.WA.DW.DT.DRE 
1 .TFVD.TLVO.FVO.LVD.IEX 

COMHON/FLA/  I TR SP . I MELE . I TUFX . I A NN . I P R . IMI S , I READ 
I NT  EGER *4  ATHR(7).T0(R),DLN(5).RUB(21),R0UT(6),PTIT(19)* 

1 C0M(5), TUX(6.5 ) .FSC(6) iNHE (l,3)»ODT( 3b .21) .T(21) 

1 ,TIT(24) .C0UNT,C0NT(5) .IEX(4,3) 

INTEGER»2  MS , DD ( 3 ) . I DO ( 3 ) » ADD ( 3 ) »R . CUA ( 4 ) , W A (4 ) 

INTEGEP*2  ITRSP.IMELE.ITUFX.IANN.IPR.IMIS.IREAD  . 

INTEGER  *2  FVD(3).LVD(3).0(3)  ,D’:.DDD(3) 

INTEGER»4  DRE»DT(5).DW(5)»DL(5).DA(7).IT(24),DT0(8)»KNT 
DOUBLE  PRECISION  DT J . T F » T L . T JUL . T FVD. TL VD. T I M . T J 
INTEGER.2  IPAGE.IPRINT 
C INITIALIZE  FOUND  COUNTER 

KNT  = 0 

C INITIALIZE  THE  FIRST  FOUND  FLAG 

IPAGE=0 

C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

IPRINT=0 
3 URITE(l.l) 

1 FORMAT! » THIS  IS  THE  WHO  TO  / ADDRESSEE  SEARCH*./. 

1 • WHAT  IS  THE  DESIRED  ADDRESSEE  • . / ) 

READ(1,2,ERR=3)DT0 

2 FORMAT(6A4)  . 

WRTTE(1.2)DT0 

C READ  DOCUMENT  RECORD  OF  THE  APPROPRIATE  SUB-FILE- 

100  CALL  RDSUB 

C IS  THE  SEARCH  COMPLETED  ON  ALL  SELECTED  SUB-FILES 

IF(IREAD.EO.l)  GOTO  200 
IM=IDD(1) 

I0=IDD(2) 


) 
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<1346)  IY=IDD(3) 

<1346)  CALL  JTIME(IY,IH.ID»0»0t0.TIH) 

<134'»)  1F<TFVD.LE.TIH  .AND.  TIH.LE.TLVO)  GOTO  890 

<13481  GO  TO  100 

<1349)  890  CONTINUE 

<1350)  DO  101  1 = 1, P, 

<1351)  IF<TO<n.NE.DTO<D)  GOTO  100 

<1352)  101  CONTINUE 

<1353)  C WHO  THE  DOCUMENT  WAS  SENT  TO  IS  FOUND 

*135'!)  C IS  THIS  THE  FIRST  RECORD  FOUND 

<1355)  IF<1PAGE.NF.C)  GOTO  160 

<1356)  C SET  UP  FOR  HEADING  DISPLAY 

<1357)  ITEM=4 

<135P)  IPAGE=1 

<1359)  C DISPLAY  »UHO  TO*  HEADING  ON  USER  TERMINAL  SCREEN 

<1360)  CALL  SCRNHD<ITEM) 

<136l)  C DISPLAY  RECORD  FOUND  ON  USER  TERMINAL 

<13L2)  160  CALL  SCRNPT(ITEM) 

<136:.)  C IS  THIS  FOR  TOP  OF  PRINTER  PAGE 

<1364)  IF<IPKINT.NE.O)  GOTO  170 

<1365)  C PRINT  WHO  TO  HEADING  ON  PRINTER 

<1366)  CALL  HARDHD<ITEM) 

<1367)  . IPKINT=1 

<1368)  C PRINT  RECORD  FOUND  ON  PRINTER 

<1369)  170  CALL  HARDPKITEM) 

<1370)  C IS  THIS  THE  DOTTOM  OF  THE  PRINTER  PAGE, 

<1371)  C YES,  SET  TOP  OF  PRINTER  PAGE  FLAG 

<1372)  190  IF<KNT/14.E0.KNT/14.)  IPRINT=0 

<1373)  GO  TO  100 

<1374)  C DISPLAY  NUMBER  OF  DOCUMENTS  FOUND 

<1375)  200  WRI TE<  1,300) 

<1376)  300  FORMAK*  •/) 

<1377)  URITt<l,250)KNT,DTO 

<1378)  250  FORMAK*  THERE  ARE  *15*  DOCUMENTS  WITH  AN  ADDRESSEE  OF*,/ 

<1379)  1 8A4/) 

<1380  RETURN 

<1381)  END 


1 
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SUBROUTINE  CKIR(IR,I) 

C THIS  SUBROUTINE  PERFORMS  A CHECK  AND  WARNING  FUNCTION 

C TO  THE  USER  IF  A REVISE  OF  THE  HAIL  STATUS  ITEM  IS  REQUESTED 

C 

INTEGER02  IR,I,IAN 

C IS  THIS  A HAIL  STATUS  REQUEST 

IF(IR.EO.l)  GO  TO  100 
C SET  LEGAL  REVISE  FLAG 

50  1=1 

RETURN 

h DISPLAY  UARNINO  TO  USER  TERMINAL 

C HAIL  STATUS  IS  CHECKED  IN  EVERY  STEP  OF  INPUT  FOR  VALIDITY 

C THUS  THE  CONCERN  FOR  A REVISE  OF  THE  FOLLOWING  DATA  FIELD 

C 

100  WfilTE(l.lOl) 

101  FORMAT! » PLEASE  CHECK  TO  HAKE  SURE  THAT  YOU  WISH  TO  REVISE  •»/. 
1*  THE  HAIL  STATUS  ITEH.  IF  CERTAIN  ENTER  YES’,/, 

1’  ELSE  NO»/) 

READ(1,10)  IAN 
10.  F0RHAT(1A2) 

IFdAN.EO.*  YE»  ) GOTO  50 
IF(IAN.NE.*NO*)  GOTO  100 

C USER  HAS  RECONSIDERED  REQUEST:  CLEAR  LEGAL  REVISE  FLAG 

1 = 0 

RETURN 

END 
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(1408) 

<1400>  C 

(1409)  C 
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(1430)  C 


SUBROUTINE  INPSC 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COMMON/BLK/  MS , ATHR , DD , T 0 , DLN ♦ SUB . R OUT f I OD tCWA tCONT ♦ 

1 ADD*TWX«F5C,NRrtDDTtR*PTIT, COUNT, CON 

COMMON /SRC/  KNT,DH,nA,DDD,DTO,nL,IT,D,WA,DW,OT,ORE 
1 ,TFVD,TLVD,FVD,LVD,IEX 

COMMON/ FLA/  ITRSP,IMLLF,ITt.'FX,lANN,TPR,IMIS,IREAO 
INTEGER ‘4  ATHR( 7) ,TO(P) ,[)LN(5)  ,SUB(21 ) ,ROUT (6) ,PT1T ( 19)  , 

1 C()N(5  ),TV.'X(6,‘j)  ,FSC  ( f.)  ,NRI  ( l,3),nni  (30 ,21  ) ,T  (21) 

1 ,T IT (24) .COUNT ,CONl (5  ) ,ir X(4 ,3) 

INTEGEP*2  M‘;,I)D(3)  , IDD  ( 3)  .ADD  ( 3)  ,R,CUA  (4  ) , UA(4  ) 

INTEGER *2  ! TRSP , I Ml  L F , I T U F X , I ANN  , I PR , 1 M I S , I R E AD 
INTEGER*2  F VP  ( 3 ) , L V !■  ( 3 ) , D ( 3)  , f:  , DDD  ( 3 ) 

INTEOER*4  01  F ,D I (5) ,nw (5) ,DL(5) ,DA(7) , IT (24) ,CTO (8) ,KNT 
DOUBLE  PRECISION  DT J , TF , TL , T J UL , TF VD , TL VD, T I H, T J 
INTEGER*2  IF  , I , J, I I , 1 1 1 
INTEGER*4  APR  AY  (4  ) , [iLNK 
INTEGER*2  BUF ( 7f ) , I OPT 

THIS  ROUTINE  PROVIDES  THE  BASIC  I/O  FOR  THE  INPUT/REVISE  ROUTINES 

IF(R.EO.C)  GO  TO  100 
URITE(1,1) 

FORMAT!*  HOU  MANY  ITEMS  DO  YOU  WISH  TO  REVISE  (MAX  OF  14)*,/) 

RFAD(1,10,ERR=2)IKNT 

FORMAT! 13) 

IF ( IKNT.LT. 0 ) GO  TO  2 
IF(IKNT.GT.14)  GO  TO  2 
DO  9999  LP=1 ,IKNT,1 
UP.ITF(1,3) 

FORMAT!*  INPUT  THE  ITFM  NUMBER  THAT  YOU  WISH. TO  REVISE*,/). 
RF.AD(1,10,ERR  = 5)IR 
CALL  CKIR(IP,I) 

IF(I.GT.O)  CO  TO  100 
CO  TO  r 
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(1A31)  C BEGIN  INPUT 

(1*32)  C 

(1A33)  100  IF(R.EO.l.AND.IR.NE.l)  CO  TO  200 

(l'i34)  103  WRITr<l,101)  . 

(143‘j)  101  FORHAK 

(1430  !•  (1)  MAIL  STATUS  - (VC)  VOUCHT  CORRESPONDENCE • »/* 

(1437)  1*  (IM)  INCOMING  MAIL’t/* 

(1430)  !•  (OK)  OUTGOING  KAIL**/ 

(1439)  1*!  !**/) 

(1440)  READ(1*104,CRR=103)MS 

(1441)  ■ IF(HS.EO.*VC*)  GO  TO  105 

(1440)  IF(MS.EO. »in*)  GO  TO  105 

(1443)  IF(MS.EG. ’OM*)  CO  TO  105 

^03  (1444)  URITE(1*106)M.S 

yjsJL  ( 1445)  106  FORMAT  ( *GGTHE  MAIL  STATUS  CODE  YOU  HAVE  ENTERED  (»A2* 

(144f)  1»)  IS  NOT  VALID  - TRY  AGAIN*/) 

(1447)  GO  TO  103 

(1448)  104  F0RHAT(1X»A2) 

(1449)  105  WRITE(ltl04)MS 

(1450)  200  IF(R.E0.1.AND.IR.NE.2)  GO  TO  300 

(1451)  2C1  U'RITE(1*202) 

(1452)  202  FORMAT(»  (2)  AUTHOR/SOURCE**/ 

(1453)  1 * ! * *28 X,* ! * /) 

(1454  ) RrAD(l«203.t:RR  = 201)ATHR 

(1455)  URITE(1,203)ATHR 

(1456)  203  FORMAT (IX, 7A4) 

( 1457)  300  If  (P.Ei:.l.AND-IR.NF.3)  GO  TO  400 

(1458)  30  1 UR ITF (1 ,302  ) 

(1459)  302  FORMAK*  (3.)  DOCUMENT  DATF  *,/,*!  HMDD  YY  !*/ ) 

(1460)  RFAD(1,303,FRR=301)DD 

(1461)  303  FORMAT (IX, 312) 

(1462)  IF (DD(1).GT.12)  GO  TO  301 

( 1463)  IF (DD(2).GT.31  ) GO  TO  301 

(1464)  URITE(1,3C3)DD 

(1465)  400  IF(R.EQ.1.ANG.IR.NE.4)  GO  TO  500 

(1466)  4C1  UMTE(;1,402) 

(1467)  402  F0HMAT(*  (4)  TO  * , / , * ! • 3 2 X, ♦ ! » / ) 

( 1468)  READ(l,403,r.P.R=401)TO 
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<1A69> 

A03 

F0RHAT(1X»8AA) 

(1A70) 

URITE(ltA03)TO 

(1A71 > 

500 

IF(R.E(5.1.AND.IR,.NE.5)  GO  TO 

600 

(l'»72) 

501 

WRITE  (1  ,502) 

(1A73) 

50  2 

FORMAT(*  (5)  UOCUMENT/LETTFR 

NUMBER*,/,* !* ,18X 

n'i7't) 

REAO(l(503(rRR=501)DLN 

( l't7J)) 

503 

FORMATdXtAAAtAP) 

(1^176) 

URITE(1,503)  OLN 

(1A77) 

60  0 

IF  (li.E0.1.AA:D.IR.rJE.6)  GO  TO 

700 

flA78) 

601 

UKnr(l,602) 

(1A79) 

602 

FORMAT(»  (6)  GUDJECT  (7  WORDS  - 10  CHAR/WORD)* 

( 1 '1 1'  0 ) 

!•  ! •,76y.,»  ! •/) 

(I'lf  1 ) 

LEN=10 

<lAf-.2) 

CALL  TIFCPUT  (TIT,LEN) 

(lABJ) 

CC  610  IJ=1,21 

n'16'i) 

610 

SUn(IJ)rTIT(IJ) 

(lAet) 

URITE( 1,603)GUB 

(1A8C) 

603 

F0F.F’AT(7(1X,2AA,A2)) 

(l‘*P7) 

700 

IF  (R.EO.l.ArJL.IR.NE.7)  GO  TO 

800 

( 1A88) 

701 

WRITE(1,702) 

(1A89) 

702 

FORRAK*  (7)  ROUTING*, /»&(*! 

!*)/) 

(1A90) 

READ( 1 ,703,ERR=701)ROUT 

(1A91) 

703 

F0RMAT(6(1X,A3,1X)) 

(1A92) 

WRITE(1,703)  ROUT 

(1A93) 

800 

IF(R.EQ.l. AND.IR.nl. 8)  GO  TO 

900 

(1A9A) 

801 

WRITL(1,S02) 

( 1A95) 

802 

FCKNAT(*  (8)  INPUT  DATA  DATE 

*,/,*!HKDDYY!*,/) 

(1A96) 

IF(R.EO.O)  GOTO  805 

«1'(97) 

RLAD(l,P03,i  RR  = 801)IDD 

(1A98) 

803 

FORMAT (IX, 312) 

■ • 

( 1A99) 

GO  TO  810 

(1500J 

805 

REWIND  10 

(1501) 

RLAO(10,803> IM, ID,1  Y 

( 1502) 

IDD(l)iIH 

(1503) 

IDD(2)=I0 

(150'') 

IDD(3)=IY 

(1505) 

Rf WIND  10 

(1506) 

810 

WRITL(1,803)  IDD 
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(15071  900  IF(R.EQ.1.AND.IR.KE.9)  GO  TO  950 

(1508)  ^01  URlTE(l«902) 

(1509)  902  FORHAT(*  (9)  W.A.  NUMBER  / ID.  CODE**/,  • 

(1510)  1*  ! * ,8X,  • ! ♦/ ) 

(1511)  READ(1,903,FRR=901)CUA 

(1512)  903  FCHMAT(1X,AA2) 

(1513)  URITE(1,903)CWA 

(151A)  CALL  GETCON. 

(1515)  IF(CON(l).NE.*  .» ) GOTO  1001 

(151G)  909  UR1TE(1,910) 

(1517)  910  FORMAT!*  IS  THERE  A CONTRACT  NUMBER  FOR  THIS  DOCUMENT  (YES  OR  NO)* 

(1518)1) 

(1519)  READ(1,2300,ERR=909)  lOPT 

(1520)  IF ( lOPT.EQ. » YE* > GOTO  951 

(1521)  IF(IOPT.NE.*NO*)  GOTO  909 

(1522)  . GO  TO  1050 

^ (1523)  950  IF (R.EQ.l.AND.IR.NE.lO)  GOTO  1100 

I (152A)  951  URITE(1,95?) 

^ (1525)  952  FORMAT!*  (ID  CONTRACT  NUMBER *,/,*!*, 20 X ,*!*/ ) 

S (1526)  READ! 1,953, ERR=951)  CONT 

’ (1527)  953  FCRHAT(lX.,5A'i) 

(1528)  WRITE(1,953)C0NT 

(15?9)  GO  TO  1 100 

(1530)  1001  WRITE (1  ,1002)CON  , ’ 

(1531)  1002  FORMAT!*  CONTRACT  NUMBER  *,5A4) 

(1532)  1050  DO  1060  1=1,5 

(1533)  CONT(I)=CON(I) 

(153A)  1060  CONTINUE 

(1535)  1100  IF(R  .EG.l .AND.IR.NE.ll)  GO  TO  1200 

(1536)  1101  URITE(1,1102)  • ' 

(1537)  1102  FORMAT!*  (11)  ACTION  ITEM  DUE  DATE *,/,*! MMDDYY !*/ > 

(1538)  READ(1,1103,ERR=1101)ADD 

(1539)  IFIADDd)  .GT.12)  GO  TO  1101  ' . ' • . , , • 

(15A.0)  . 1F(ADD(2).GT.31)  G(}  TO  1101 

(15A1)  URITE(1,1103)ADD 

(15A2)  1103  FORMAT! IX, 312) 

(15A3)  1200  1F(R.EU.1.AND.IR.NE.12)  GO  TO  1300  . ' . • 

(15A4)  1202  UR1TE(1,1204) 
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(1621) 

Af(RAY(4)  = BLNK 

(1622) 

CALL  GETURD(BUF, ARRAY, LEN) 

(1623) 

T1T(I)=ARRAY(1) 

( 162<^) 

T1T( 1*1 )=ARRA Y(2) 

(1625) 

TIT(  I + 2)  = ARRAY( 3) 

(1626) 

TIT(I*3)=ARRAY(4) 

(1627) 

I = I*2 

(1628) 

1531 

CONTINUE 

1 1629) 

UFITE(ltl506)(TIT(I),I=l,21) 

(1630 

1506 

FORMAT ( 7( IX ,2A4,A2) ) 

(1631) 

Ilfi=21 

(1632) 

DO  1507  J=1,I18 

(1633) 

DDT(IJ,d)r.f  » 

(1634) 

DDT(IJ,d)=TIT(J) 

(1635) 

TIT(J)=*  * 

(1636) 

1507 

CONTINUE 

(1637) 

IBOA 

CONTINUE 

(1638) 

2200 

CONTINUE 

(1639) 

6 = 1 

(1640) 

IR  = 0 

( 1641 ) 

9999 

CONTINUE 

(1642) 

CALL  SHOUC 

(1643) 

2302 

WRITE(1,2303) 

'1644  ) 

2303 

FORMAT!/, IHO,/,*  CHECK  RECORD  FOR  ERRORS! 

(1645) 

1/,26X,*IF  REVISION  NEEDED,  ENTER  REV*/) 

(1646) 

READ(1,2300) lOPT 

(1647) 

2300 

F0RMAT(1A2) 

(1648) 

IF(IOPT.EC.*RE»)  GOTO  2 

(1649) 

IF(IOPT.NE.*CO»)  GOTO  2302 

(1650) 

C 

(1651) 

C 

END  OF  INPUT  REVISE  ITEMS  AS  OF  8/26/78 

(1652) 

C 

(1653) 

RETURN 

(1654  > 

END 

IF  CORRECT*  ENTER  COR»* 
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ADO 

I 
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DUF 
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CK  IR 

R 

EXTERNAL 

OOOOOO 

1A27 

CON  . 

J 

/BLK/ 

002731 
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1515 
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1533 

CONT 

J 

/BLK/ 

000151 

lAOSS 

1526K 

1528 

1533H 

COUNT 

J 

/rLK/ 

002727 

1A09S 

CWA 

I 

/BLK/ 
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1A09S 

1511H 
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0 

I 

/SRC/ 
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DA 

J 

/SRC/ 
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I 
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ODD 

I 
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DDT 
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OL 
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DH 
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DRE 

J 

/SRC/ 

000 171 

lAOSS 

DT 
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/SRC/ 

000157 

1A09S 

DTJ 

D 
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1 A 0 9 S 

OTO 
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/SRC/ 

OC002A 

H 0 9 S 

DW 

J 

/SRC/ 

C001A5 

1 AO  9 S 

FSC 

J 

/f.LK/ 

000262 

1A09S 

157A  M 

1576 

FVD 

I 

/SRC/ 

000203 

1A09S 

GETCON 

R 

EXTERNAL 

OOOOOO 

151R 

CETURD 

R 

EXTERNAL 
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1622 

I 

I 

00R031 

lAlOS 
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1428 
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1533 

1615M 

1616 

1617H 

1623 

1624 

1625 

1626 

1627M 

1629 
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I 

00'(03A 

1631M 

1632 

lA 

I 

n0‘t035 

15<t7M 

1549 

lANN 

I 

/FLA/ 
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1A09S 

IR 

I 

00A036 

1582.M 

1583 

IC 

I 
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1549 
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IDD 

I 

/BLK/ 

0001A2 

1AQ9S 

1497M 

1502M 

1503H 

150  4H 

1506 

lEX 

J 

/SRC/ 

000211 

1A09S 

B-125 


SURROUTINf  INPSC  PAGE  0123 


II 

1 

OOAOAl 

1410S 

1558M 

1561 

1562 

1566H 

1568 

III 

I 
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IJ  . 
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1507 
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000006 
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IT 

J 
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ITRSP 
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1409S 

ITUFX 

I 
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00CC02 
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IT 

I 

004052 

IbOlM 

1504 

J 

I 

004053 

1410S 

1561M 

1562H 

1567H 

1568 

1592M 

1593M 

1632K 

1633 

1634 
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J 
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140RS 
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•I 

004055 

1461H 

1482A 

1609M 
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LOOPl 

I 

004056 

1546H 
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1565 

1581M 

15fi5H 

1587 

1588 
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004057 

14  23M 
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NRE 
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1563M 

1592M 

1593 

PTIT 
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002661 
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R 

I 
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002660 

14C9S 
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1433 

1450 

1457 

1465 

1471 

1477 

1487 

1493 

1496 

1507' 

1523 

1535 

1543 

1571 

1577 

1595 
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RDCOM 

R 

EXTERNAL 
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ROUT 

J 
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1409S 
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1492 

SHOUC 

R 
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1642 
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SUB 

d /bLK/ 

00005A 

1409S 

1484H 

1485 

\ 

T 

J 

000126 

1409S 

TF 

0 

000000 

1409S 

TFVD 

D /SRC/ 

000173 

1409S. 

TIM 

D 
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1409S 

TINPUT 

R EXTERNAL  000000 
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TIT 
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1409S 

1482A 
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1616M 
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1626M 

1629 

1634 
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D 

000000 

1 4 0 9 S 

TJUL 

D 

000000 

1409S 

TL 

D 

000000 

1409S 

TLVO 

D /SRC/ 

000177 

1409S 

TO 

J /bLK/ 

000022 

1409S 

1468H 

1470 

TWX 

d /FiLK/ 

000166 

14C9S 

1549H 

1561H 

1562 

1568H 

CO 

UA 
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OOOl'tl 

14  09S 
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1417 
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14200 

1426 
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1416 

1428 
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_1210 

002423 

1547 

15510 

_1211 

002415 

1548 

15500 

_1220 

002442 

1552 

1553D 

\ 

. 

• 

.) 
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I'cSO 

002454 

1556D 

_1?51 

002460 

1556 

1557D 

_12£  0 

002607 

155B 

1564D 

12f.2 

002513 

1559 

15600 
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15630 

12  70 

002643 

1566 

15700 

_1272 
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1543 
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15710 
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1574 
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1572 

15730 
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1574 

15750 
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1571 

1577D 
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C02776 

1578 

15790 

l<rC2 

003077 

1585 

15860 

„M03 

002772 

1578D 

1585 

1587 

09 

1 

_1‘  OA 

003115 

1589 

15900 

003214 

1592 

1593 

15940 

ro 

_14C8 

003057 

1582 

15840 

_15C0 

003224 

1577 

158  8 

15950 

..1501 

003237 

1596U 
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160  6 
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CC3243 

159  6 

15970 

lt.03 

003352 
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16  050 
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1608, 
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1505 

003377 

1610 
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1506 

003606 

1629 
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150  7 

003663 
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_1510 
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16030 

1511 
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_1521 
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1615 
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1417D 
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_200 

000713 

1433 
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1451D 
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_2  0 2 

000732 

1451 
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000775 

1454 

1455 

1456D 

_2200 

003667 

1595 

1607 

16380 

. 2300 

CC4004 

1519 

1646 

1647D 

■ _2302 

003706 

1643D 

1649 
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2303 

003712 

1643 

16440 

_3 

000361 

1424 
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”300 

001002 

1450 
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“301 

001015 
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COIOPI 
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1488D 
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001437 

1488 

14890 

_7  03 

001470 
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001524 
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001530 
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001571 
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500 
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15070 

_901 

00165f> 

1508D 

1511 

_902 

001662 

1508 
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1)01724 

1511 

15120 

1513 

_909 

001752 

151  6D 

1519 

1521 
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001756 

1516 

15170 
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00204? 

1507 

15230 
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002056 

1520 

15240 

1526 
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9“)  2 
953 
9999 


002062  1529  1525D 

002120  1526  1527D 

003675  1923  1691D 
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(16555  SUBROUTINE  GETCON 

(1656)  C 

(1656)  C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  KAIL  LOG  FILE 

(1656)  C 

<16bf.)  COMKON/BLK/  MS  ♦ ATHR  , DD  , T 0 . DLN  , SUB  ,ROUT  » I DD  .CUA  ,CONT  . 

(1656)  1 AODf TUX, FSC»NRE*DDT,R,PTIT, COUNT, CON 

(1656'  COMMON/SRC/  KNT ,D M , DA , ODD ,0 TO , DL , I T , D , UA ,D W, DT ,DRE 

(1(56)  1 ,TFVn,TLVD,FVD,LVD,lFX 

(1656)  COMHON/FLA/  I TRSP , 1 KELE , 1 TUFX , 1 ANN, IPR , IN  I S , I R E A D 

(16561  _ INTEGER*AATHR(7),TP(S),DLN(5),SUB(21>,RCUT(6),PTIT(19), 

(1656)  ‘ 1 CCN(b) ,TUX(6,b) ,FSC( 6) ,NRE(1 ,3), DDT( 30 ,21) ,T( 21) 

(1656)  1 ,TIT  (PR)  ,rC'UM  ,CONT(f> ) , IEX(A,3) 

(1656)  INTFGER*2  MS , DD ( 3 ) , I DC ( 3 > , ADD < 3 ) , R , CUA ( R ) , UA ( R ) 

(1656)  INTEGER*2  I TRSP  , I KF.LE  , 1 T UFX  , I ANN  , I PR  , I M I S,  I R E AD 

CD  (1656)  INTEGER*2  F VO  ( 3 ) , L V D ( 3 ) , D ( 3 ) , DV. , ODD  ( 3 ) 

(1656)  INTEGER*R  D RE  , D 1 ( 5 ) , DU  ( 5 ) , CL  ( 5 ) , D A ( 7 ) , 1 T{  2R  ) , DTO  ( 8 ) ,KNT 

(1656)  DOUBLE  PRECISIOt'  D I J , TF  , T L , T JUL  , TF  VD  , TL  VD,  T I M,  T J 

(1657)  C SYSCOh>KEYS.F  MNEMONIC  KEYS  FDR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(1657)  NCLIST 

(1658)  CALL  SRCH$$ (KSPOUR+KSNCAM , »CTAU  », 6, 16, 1,10 

(1655)  REUIND  20 

(1660)  650  READ(20,655,END=690)UA,CON 

(1661)  655  F0RMAT(5X,RA2,2X,5AR) 

(1662)  IFtCUAd)  .EG.»  »)  GOTO  680  ' 

(1663)  IF(CUA (1 ) .FO. *33» .AND.CUA (2) .EG.*02»)  GOTO  670  *' 

(166';)  IF(CWA<l).EG.»3R’.AtJD.CUA(2).'EG.*04*.0R.CUA(2).EO.»09»)  GOTO  660 

(1665)  IF (CUA ( 1 ) .NF.UA (1 ) ) GOTO  650 

(1666)  IF(CUA(2).NE.WA(2))GOT0650 

(1667)  GO  TO  800 

(1668)  660  DO  665  1 = 1, R 

(1669)  IF (CUA ( I) .NE.UA(I) ) GOTO  650 

(1670)  665  CONTINUE 

(1671)  GO  TO  800 

(1672)  670  IF(CUA(1).NF.UA(D)  GOTO  650 

(1673)  IF (CUA(2> .NE.UA (2) ) GOTO  650 

<167R)  IF(CUA(3) .NE. * ad* . AND.CUA ( 3) .NE.*BA» ) GO  TO  800 

(1675)  IF (CUA( 3) .EG.*An* .AND.UA { 3) .EG.* A •)  GOTO  800 

•1676)  IF (CUA(3> .EG.*BA* .AND.WA(3) .EQ.*B  *)  GOTO  800 
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(l.i77) 

GO  TO  650 

600 

DO  685  J=l»5 

<1679' 

CON(J)=*  • 

(1S80) 

685 

CONTINUE 

(1661) 

CO  TO  800 

(16.62) 

69  0 

CON(l)=*UA  NV 

<iCS3) 

C0N(2)=*0T  F» 

(168^) 

C0N(3)=»0UN0» 

(1605) 

CON(A)=»  SEE* 

(1686) 

C0N(5)=*  RJK* 

(1607) 

300 

REWIND  20 

(1680) 

CALL  SRrHlJ(K$CLOS»»CTAD 

(168,9) 

RETURN 

(lOEO) 

1 NO 

03 

I 
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I 

/BLk/ 

000163 

1656S 

ATHR 

J 

/FLK/ 

000001 

1656S 

CON 

J 

/[  LK/ 

002731 

1656S 

1686M 

1660H 

1679H 

1682H 

1683H 

CONT 

J 

/DLK/ 

000151 

1656S 

COUNT 

J 

/PLK/ 

002727 

1656S 

C'.'A 

I 

/CLK/ 

0OO145 

1656S 

1662 

1663 

1664 

1665 

1672 

1673 

1674 

1675 

1676 

D I /SRC/  000136  1656S 


DA 

J 

/SRC/ 

000003 

1656S 

DD 

I 

/FLK/ 

000017 

1656S 

ODD 

1 

/SRC/ 

000021 

1656S 

DOT 

J 

/PLK/ 

000304 

1656S 

CL 

J 

/SRC/ 

000044 

1656S 

DLN 

J 

/tLK/ 

000042 

1656S 

DM 

I 

/SRC/ 

000002 

1656S 

DO 

DRE 

0 

/SRC/ 

000171 

1656S 

OT 

J 

/SRC/ 

000157 

1656S 

— » 

DTJ 

D 

000000 

1656S 

U> 

ro 

oro 

J 

/SRC/ 

000024 

1656S 

OW 

J 

/SRC/ 

000145 

1656S 

FC-C 

J 

/CLK/ 

000262 

1656S 

FVO 

I 

/SRC/ 

000203 

1656S 

GETCCN  R COOOOO  1655S 

I I 000^143  166PM  1669 

lANN  I /FLA/  000003  1656S 

IC  I 000AA6  165PA 

ICO  I /BLK/  0001A2  16B6S 

IFX  J /SRC/  000211  1656S 

IMELE  1 /FLA/  000001  16B6S 

IMIS  I /FLA/  00000b  1656S 

IPR  I /FLA/  000004  16B6S 

IREAO  I /FLA/  000006  1656S 

IT  J /SRC/  0000f)6  1656S 

ITRSP  I /FLA/  000000  165fS 

XTUFX  I /FLA/  OC0002  16b6S 

J I 000447  1678H  1679 
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CD 


<5CACC 

1 

PARAMETER 

1657R 

KICLOS 

I 

PARAMETER 

1657S 

KJCONV 

I 

PARAMETER 

16575 

KICURR 

I 

PARAMETER 

1657S 

XSfELE 

I 

PARAMETER 

1657S 

Ks  r:;PD 

I 

PARAMETER 

16575 

KIGTIM 

I 

PARAMETER 

16575 

K;  tfJTR 

I 

000000  1657S 

Kjr.  \ST 

I 

PARAMETER 

16575 

K$3t!G0 

I 

PARAMETER 

1657S 

,<iCPCS' 

I 

PARAMETER 

16575 

KSMOME 

I 

PARAMETER 

1657S 

KlICUR 

I 

PARAMETER 

1657S 

KtlHFD 

I 

PARAMETER 

1657S 

KilRTN 

1 

PARAMETER 

1657S 

Ki  ISEG 

I 

PARAMETER 

16575 

KJ  lUFD 

1 

PARAMETER 

16575 

KS-MENT 

I 

OOOOC 

)0  16575 

KS.'SIZ 

I 

PARAMETER 

16575 

KJ^VNT 

I 

PARAMETER 

16575 

1 

PARAMETER 

1657S 

KiNRTN 

I 

PARAMETER 

1657S 

KJ  fsiCAM 

I 

PARAMETER 

16575 

KiNoGC 

I 

PARAMETER 

16575 

-'.iNSGS 

I 

parameter 

16575 

KiPOSA 

I 

PARAMETER 

1657S 

KiPOSN 

I 

PARAMETER 

1657S 

KJPOSR 

I 

PARAMETER 

1657S 

KSPSEA 

I 

PARAMETER 

16575 

KiPntR 

I 

PARAMETER 

16575 

KSPROT 

I 

PARAMETER 

16575 

KiSnUR 

I 

PARAMETER 

16575 

KJRFAD 

I 

PARAMETER 

16575 

KS'lPOS 

I 

PARAMETER 

16575 

KJRSUB 

I 

PARAMETER 

16575 

KiRMLK 

I 

PAF.AHl  TER 

16575 

KSSI  rjT 

1 

00000 

0 1657S 

KJSCTC 

I 

PARAMETER 

16575 

1688 


1658 


1658 
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KJSETH  1 parameter  1657S' 

ESSPOS  I PARAMETER  1657S 

KSSRTN  I PARAMETER  1657S 

KITRKC  I PARAMETER  1657S 

KlUPOS  I PARAMETER  16B7S 

KSUP.IT  I parameter  1657S 

KNT  J /SRC/  000000  16BtS 

LVD  I /SRC/  00020C  16EES 

HS  I /!,LK/  000000  1656S 

NRE  J /BLK/  000276  :6Ef.S 

PTIT  J /BLK/  002661  1656S 

R I /CLK/  002660  1656S 

ROUT  J /BLK/  000126  16b6S 

SRCHSJ  R EXTERNAL  000000  1658  1688 

sue  J /L-LK/  000  054  1656E 

T J 000002  1656S 

TF  D 000000  1656S 

TFVD  D /SRC/  000173  1656S 

TIM  D 000000  1656S 

TIT  J 000054  1656S 

TJ  , D 000000  1656S 

TJUL  D 000000  1656S 

TL  D 000000  1656S 

TLVD  D /SRC/  000177  1656S 

TC  J /PLK/  000022  1656S 

TtX  J /LLK/  000166  1656S 


UA 

I /SRC/ 

000141 

1656S 

1660M 

1665 

1666 

1669 

1672 

1675 

1676 

_650 

000147 

16600 

1665 

1666 

1669 

1.672  . 

1673 

7655 

000163 

1660 

1661D 

_66  0 

000257 

1664 

1668D 

Zfc65 

000271 

1668 

1670D 

670 

C003DO 

1663 

1672D 

_680  ■ 

000357 

1662 

1678D 

_685 

000372 

1678 

16S0D 

. 690 

000401 

1660 

16820 

_200 

000427 

1667 

1671 

1674 

1675 

■ 1676 

1681 
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(U9I) 

(1692> 
( lc.925 
(1692) 
(1692/ 
di-92) 
(1692) 
(1692) 
(1692) 
(1692) 
(169  2*- 
(1692) 
(1692) 
(1692  ) 
(1692) 
(1692) 
(169S' 
(1693/ 
(1699) 
(1695) 
(1996) 
(1697) 
(1698) 
(1699) 
(1700) 
(1701) 
(1702) 
(1703) 
(1709) 

(1705) 

(1 (Ob) 
(1707) 
( 1708- 
(1/09) 
(17  .)  0 / 
(1711) 
(1712) 


SUBROUTINE  REVSC 

C . ■ 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

C 

COHMON/ELK/  MS* ATHR ♦ DD « TO» DLN ♦ SUB » ROUT, I DD » CUA .CONT , 

1 ADD,  TU'X,FSC,NRE, DDT, R,PTIT, COUNT, CON 

COMMON /SRC/  KNT  ,DM,riA,DDD,DTO,nL  ,IT  ,D,UA,DU,DT,DRE 
1 ,TFVD,TLVD,FVD,LVO,IEX 

COHHON/FLA/  I TR  SP  , I MELf.  , I TUFX  , I ANN  , IPR  , IM I S , IR  E AD 
INTEGER*A  ATHR(7),T0(fl),0LN(5),SUB(21),RnUT(C-),PTIT(19), 

’ 1 CON(‘j)  , TUX(6,5)  ,FSC(6)  ,NRF  ( 1 ,3),  DDT(  30,21)  ,T(21) 

1 ,111(29)  ,COUNT ,CONT (5 ) ,IEX( A,3) 

INTEGER*2  HS,0D(3)  ,IDD(3)  ,ADD(3)  ,R,CWA(A),U'A((t) 

I NT  EGER  *2  I TRSP  , I Ml  LE  , I T'/l  F X,  I A NN  , IPR  , I H IS  , IRE  AD 
INTEGER *2  FVB(3),LVn(3),D(3),C'’,DDD(3) 

INTECER*A  DR£,DT(5),DW(5),DL(5),DA(7),IT(24),0T0(8),KNT 
DOUBLE  PRECISION  DT J , TF , T L , TdUL , TFV D , TL V 0, T 1 M , TJ 
C SYSCOM2KETS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER«4  ICOUN 

INTEGER*2  I OPT , FI N I SH , I A , A ( 1 5 ) , I N 
C 

r THIS  IS  THE  REVISE  ROUTINE  FOR  THE  HAIL  LOG  FILE 

C THE  MAIL  LOG  DOCUMFNT  TO  BE  REVISED  OR  DELETED 

C KEYED  ON  THE  INPUT  DATE  AND  COUNT  CODE 

C 

C INITIALIZE  FINISHED  FLAG 

FINISH=0 

C INITIALIZE  CHANGE  IN  TR ANSHI T TAL /SPEC  IF IC ATION  FLAG 

IA  = 0 

C CLEAR  USER  TERMINAL  SCREEN  FOR  DISPLAY 

CALL  CLEAR 
CALL  TIMOAT (A, 15) 

IF{A(13).EO.»dU'*.OR.A(13).EQ.»NH».PR.A(13).rQ.»RJ*,OR.Atl3).EQ. 

1 ’OK*)  GOTO  3 
WRin  (1  ,A) 

A FORMAT(»  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.*,/, 

1*  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT.  2621 


) 


J 
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(1713) 

(171A) 

(1715) 

3 

(1716) 

1 

(1717) 
d 71P) 
(1719) 

2 

d 72  0 ) 

5005 

(1721) 

5000 

(1722) 
(1723) 
d72R' 
(IV 25) 
(1726V 

C 

(172?) 
d ;2ft) 

C 

d Y29) 

C 

(1730) 

t 

(1731) 

C 

(1732) 

(1733) 

100 

(1739) 

(1735) 

c 

(1736) 

(1737) 

c 

(1738) 

(17391 

(1790) 

(1791) 

110 

(1792) 

c 

(1793) 

(1799) 

(1795) 

1700 

(1796) 

(1797) 

1800 

(1795) 

50 

(1799) 

(1750) 

l.») 

RETURN 

URITEdfl) 

FORMATE'  PLEASE  ENTER  THE  INPUT  PATE  AND  COUNT  CODE  OF  THE'»/« 

1'  DOCUMENT  TO  BE  REVISED  OR  DEL ETED './*♦!», tx, •!!*♦ 3X d 
READ( 1 ,2tERR=3) C, ICOUN 
F0HMAT(1X,312,2X,I3) 

WRITEEl tSOOO) 

FORMAT { IXf ' IS  THIS  A SPECIAL  ACTION  DUE  SUBFILE  DELETE  REQUEST'*/* 
111X*'<YES  OR  NO)'/) 

READd  ,50)  lOPT 
IFdOPT.EG.'YE*)  GOTO  6000 
IF( lOPT.NE.'NO')  COTO  5005 

DETERMINE  SUB  FILES  TO  BE  OPENED  FOR  SEARCH 
CALL  UHERL 

IS  THE  tranehittal/specification  flag  set 

YES,  PERFORM  SEARCH  AND  REVISE  OF  SUB-FILE  TRAN 
IF( ITREP.EQ  .0)  GOTO  1001 

READ  ( 6,  END  = ?0  0 ) MS  , ATHR  , DD,  T0,DLN  ,SUrj  ,PT  I T, 

1 ROUT,I  PD,COUNT  ,CV;a  , CONT  , ADD*TWX,FSC,NRE  ,DDT 
IS  THIS  REVISE  COMPLETED 
IF(FINISH.EQ.l)  GOTO  125 
FIND  DOCUMENT  TO  BE  REVISED 
IFdCOUN.NE. COUNT)  GOTO  125 
DO  110  1=1,3 

IF(IDDd).NE.Dd)  ) GO  TO  125 
CONTINUE 

CONFIRM  RECORD  TO  BE  REVISED 
CALL  SHOWC 
WPITEd,1700) 

FORMAT (/,  IHO,/, ' IS  THIS  THE  CORRECT  RECORD  TO*  BE- REVISED  OR  DELET 
lED',/,'  (YES  OR  NO)') 

READ d ,50) lOPT 
F0RMATdA2)  . 

IF(IDPT.EC.'NO')  COTO  125 
IF( lOPT.NE . ' YE')  COTO  IBOO 
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<1751) 

1900 

UR1TE(1,2100) 

<17521 

2100 

FORHAK*  IS  THIS  RECORD  TO  BE  REVISED  OR  OELETED»»/t 

<1753) 

1 » (REV  OR  DEL) •) 

<175'i) 

REAOdtSO)  lOPT 

( 1755) 

IFdOPT.EQ.’RE*)  GOTO  120 

<175f.) 

IF(IOPT.NE.*OE*  ) GOTO  1900 

<1757) 

FINISH=1 

< 1 )5C' 

GOTO  100 

<1759i 

C 

SET  REVISE  FLAG 

< 17o0) 

120 

R = 1 

<1761) 

C 

PERFORM  REVISE  OF  RECORD  ITEH(S) 

<1762) 

CALL  INPSC 

<1763) 

C 

SET  FINISH  FLAG  TO  COMPLETE 

(1764) 

FINISH=1 

<1765) 

C 

BUILD  NEW  FILE 

<1766) 

125 

WRITE (ft  IMS *ATHR  ,DD«TO»DLN  ,SUB»PTITtROUT. 

(1767) 

1 IDD»COUNT,CUA»CONT.ADD,T'JX,FSC,NRE»DOT 

<1 76ft) 

GO  TO  ICO 

(i76g) 

200 

ENDFILE  6 

< 1770) 

CALL  SKCHtS (KSCLOSt *TRAN  *f6»0»0»0) 

(1771) 

CALL  SRCHSJ (K$DELE» *TRAN  *,6t0»0,0) 

(1772) 

CALL  CNAMSl  *REVS  *,6»»TRAN  *,6*10 

(1773) 

CALL  SRCHiKKiROUR  + KSNDAMdPFVS  »»6,A»1*IC) 

<177ft- 

C 

(1V75) 

C 

IS  THE  MEMO/LETTER  SUB  FILE  FLAG  SET 

<1776: 

c 

YES»  SEARCH  AND  REVISE  THE  SUB-FILE  MEMO 

nirn 

c 

<1778) 

c 

<1779) 

1001 

IF(FINISH.EG.I)  GOTO  3000 

<1780> 

IF ( IMELE. EQ.O  ) GOTO  1002 

(1781) 

IN  = 11 

(1782) 

GO  TO  2000 

(1783) 

1002 

IF<FINISH.EQ.l  ) GOTO  3000 

<178(|) 

IE<ITWFX.EQ.O)  GOTO  1003 

(1785) 

IN=12 

(1786) 

CO  TO  2000 

(1787) 

1003 

IF(FINISH.EO.l)  GOTO  3000 

(1788) 

IFdANN.EQ.O)  GOTO  lOOA 

) ■ ) 
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(178^!) 

IN  = 13 

(1790. 

GO  TO  2000 

(1/91) 

1009 

IF(FINISH.rQ.l)  GOTO  3000 

(1792) 

IF(IPR.EQ.O)  GOTO  1005 

(1793) 

1N=19 

(1/91) 

CO  TO  2000 

(1 795) 

1005 

IF (FINISH. EQ.l)  GOTO  3000 

(1790 

IF(IHIS.EO.O)  GOTO  3000 

(1797) 

IN=15 

(1798) 

2000 

CONTINUE 

(1799) 

loi 

REAO(IN*END=201)HS, ATHR, DD« TO » DLN »SUB«PT  IT  * 

(1800) 

1 ROUT»I(jD.COUNT.CUA,CONT,  ADD»TUX,FSC»NRE 

(1801) 

C 

IS  THIS  REVISE  COKPLETED 

(1802) 

IF(FINISH.EQ.l ) GOTO  128 

(1C03) 

C 

FIND  DOCUMENT  TO  BE  REVISEO 

(1909) 

IF(CCUNT.NE.ICOUN)  GOTO  126 

(1805> 

DO  111  1=1,3 

(18081 

IF (IOD( I) .NE.D(  I) ) GO  TO  126 

(18075 

111 

CONTINUE 

(1808) 

IF(ITRSP.EQ.O)  GOTO  21 

< 1 c'  0 9 ) 

ITRSP  = tl 

(1810) 

IA=1 

(1811) 

C 

CONFIRM  RECORD  TO  BE  REVISED 

(1812) 

21 

CALL  SHOUC 

(1813) 

IF(IA.EQ.O)  GOTO  31 

(1819) 

ITRSPrl 

(1815) 

IA=0 

(ICIG) 

31 

WRITE (1,1 700) 

(1817) 

1801 

READ(1,50)IOPT 

(1818) 

IF(IOPT.EQ.*NO»)  GOTO  126 

(1819) 

IF(IOPT.NE.»YE»)  GOTO  1801 

(1820) 

1901 

URITF(1,21C0) 

(1821) 

READ(1,50)  lOPT 

(1822) 

IF(IOPT.EO.VRE’)  GOTO  121 

(1823) 

IFdOPT.NE.'DE*)  GOTO  1901 

(1829) 

FIMSH=1 

(1825) 

GOTO  111 

(1826) 

C 

SET  REVISE  FLAG 

SUBROUTINE  REVSC 


(1827)  121  R=1 

0828)  C PERFORM  REVISE  OF  RECORD  ITEH(S) 

(1S29)  CALL  INPSC 

(1830)  C SET  FINISH  FLAG  TO  COMPLETE 

(IS31)  FINISH=1 

(103J)  C BUILD  NEU  FILE 

(1833)  126  URlTE(8)HStATHR,DDfT0,DLN, SUB, PUT. ROUT* 

(1838-  1 IDD, COUNT, CUA.CONT, ADD, TUX, FSC,NRE 

(ll3b>  GO  TO  101 

(1636?  201  ENOFILE  8 

(1637)  IF(IN.FO.ll)  GOTO  2001 

(1836)  IF(IN.Efi.l2)  GOTO  2002 

(1639)  If(  IN.rC.13>  GOTO  2003 

(1680)  IF(IN.E(w.l8)  GOTO  2008 

(1881;  IFdN.EG.15)  GOTO  2005 

^ (1882)  2001  CALL  SRCH $ 1 ( K3 CLO S ♦ • MEMO  *,6,0, 0,0) 

(1883)  CALL  SRCHli (KIDELE , ’MEMO  *, 6, 0,0,0) 

(1688  ) CALL  CNAHSt(*REVS  *,6,*MEM0  *,6,IC) 

1 J (1285)  CALL  SRCHJ.$(K$RDUR*K$NDAM,*REVS  *,6,8,1,10 

(1886)  GO  TO  1002 

(1887)  2002  CALL  SR CH II ( KSCLOS , • TWFX  *,6,0, 0,0) 

(1886)  CALL  SF.CHi$(K$DELE,*TUFX  *,6,0, 0,0) 

(11:8S>  CALL  CNAM5$(*REVS  *,6,*TUFX  »,6,IC) 

(1850)  CALL  SRCHJS (KSRDWR+KSNDAM, *REVS  *,6,8,1,10 

(1851)  • GO  TO  1003 

(1652)  2003  CALL  SRCH 1 J ( KSCLOS ,* ANN  *,6,0, 0,0) 

(1853)  CALL  SRCH$$(K1DELE,*ANN  *,6,0, 0,0) 

(1858)  CALL  CNAMSl  ( * r,E  VS  •,6,'AN.N  *,6,IC) 

(1655)  CALL  SRCHSS (KtRDUR4K$NDAM, 'REVS  ' *,6,8,1,10 

(1856)  CO  TO  1008 

(1857)  2008  CALL  SRCH $ S ( K S CLOS , • PR  *,6,0, 0,0)  • 

(1058)  CALL  SRCHJ$(K1DELE,*PR  », 6, 0,0,0) 

(1859)  CALL  CNAH1$(*REVS  *,6,*PR  *,f-,IC) 

(1660)  CALL  SRCHl*.(KSK!iUR  + KlNUAM,*RFVS  *,6,8,1,10 

(1061)  GO  TO  1005 

(1862)  2005  CALL  SR  CH  1 1 ( K 1 CLO  S , • M I ?;  *,6,0, 0,0) 

(1863)  CALL  SRCHJKKiDtLE.'MIS  ',6,0, 0,0) 

«1£68>  CALL  CNAHSS ( *REVS  »,6,*HIS  *,6,IC) 


) 
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(IfcGS) 
(lets; 
<186?; 
(166fi) 
< 1069) 
(1870) 
(1871) 
(1872) 
(1873) 
(187A) 
(1875) 
(1076) 
(1877) 
(1878) 
( 1879: 
(1880) 
(1881) 
(1882) 
(1863) 
(iea<t) 
(1865) 
(1886) 
(1887) 
(1888) 
(1369) 
(1090) 
(1891) 
(1392) 
(1893) 
(18.9A) 
( 1895) 
(1896) 
(1897) 
(1890) 
(1899) 
(1900) 
(1901) 
(1902) 


CALL  SRCH$$(KIRDUR*KSNDAM» ‘REVr.  »»6»A*ltIC) 

C 

3000  RETURN 

6000  CALL  SRCHSKKlRDWR+KSNOAMt »ACTD  »,6*5,1,IC) 

RE'JIND  9 

6010  RrAD(94END-7000)ATHR»OLNfPTITtIDD,COUNT»ADD»FSC»NRE 
IF(FINlSH.tQ.l ) GOTO  6050 
IF(COUNT.NE.ICOUN)  GOTO  6050 
DO  6020  1=1,3 

IF ( IOD(I ) .NF  .D(I ))  GOTO  6050 
6020  CONTINUE 

WRITE ( 1 ,6025)PTIT,I1LN,FSC, IDD,COUNT,ATHR ,NRC,AnO 
6 0 25  FORMAT  (1  X , 19  AA  ,/ , 1 X , <t  A A , A2 , 5X  , 2 AA  , A2  , • / ♦ , 2 A8  , A2 ,5X  , 

1 2(12, •-•) ,I2,2X,I3,/,1X,7AA,2X,3(A3,1X),7X,2( 12,*-*) tl2) 

6028  URITE(1,1700) 

READ(1,50,FRH=602S) lOPT 
IF(I0PT.EQ.*N’0*)  GOTO  6050 
1F< I0PT.NE.*YE*)  GOTO  6028 
FINISH=1 

6030  WRITE (1,2100) 

READ(1,50)  lOPT 
IF(IOPT.EO.»OE*)  GOTO  6010 
IF(IOPT.NE.*RE*)  GOTO  6030 
6035  WRITE(1,60AO) 

60A0  FORMATdX, ’REVISE  OPT  1 ONS  : * , / , 7X,  » 1 . AUTHOR*,/, 

17X,*2.  nOCUMENT/LETTER  NUMBER *,/, 7X, * 3.  ACTION  DUE  DATE*,/, 
17X,*9.  FILE  SYSTEM  CODE  * ,/ , 7X , • 5 . RESPONSIBLE  ENGINEER*,/, 
IIX, ’ENTER  NUMBER  ONLY*/) 

READ(l,60't7,EKR=6035)10PT 
60A7  FURMAT(I2) 

IF(IOPT.En.l)  GOTO  6042 
IF(I0PT.EU.2  ) GOTO  6043 
IF(inPT.E0.3)  goto  6044 
IF ( lOPT.r G.4 ) GOTO  6045 
IF  (I0PT.E0.5)  GOTO  6046 
CO  TO  6035 
6042  WPITEd  ,6052) 

6052  FORHATdX, ’ENTER  AU  THOR  *,/,*!•  ,28X  ,*  1 • /) 
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(1903; 
(ISOAS 
(1905) 
(190h) 
(1907) 
(190«) 
(1509) 
(1910) 
(1911) 
(1912) 
(1913) 
(lOl^l) 
(1915) 
(191f,) 
(1917) 
(1916) 
(19191 
(1920J 
(1921 ) 
(1922) 
(1923) 
(1929) 
(1925) 
(1926) 
(1927) 
(192S) 
(1929) 
(1930) 
(1931) 
(193?) 
(1933) 
(193'l) 
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READ(l»6062«ERR=60‘l2>ATHR 

6062  FORMAT (IX, 7A4) 

GO  TO  60A8 

6093  WRITE(1,6053) 

6053  FORMATdX, 'ENTER  DOC. /LETTER  NUMBER ♦,/»»!*,  1 8X ,♦!•/ ) 

READ (1 ,6063, ERR=60 A3) OLN 

6063  F0RHAT(1X,AAA,A2) 

GO  TO  6048 

6044  WRITE(1,6054) 

6054  FORMATd X, ’ENTER  ACTION  DUE  D ATE’ , / , * ! HMDDY Y ! »/ ) 

RE  AD ( 1,6 0 6 4, ERR  = 6 0 44) ADD 

6064  FORMAT ( IX, 312) 

GO  TO  6048 

6045  WRITE(1,6055) 

6055  FORHATdX, ’ENTER  FILE  SYSTEM  CODE’ ,/,  2 ( ’ ! ’ , 10  X,  ’ ! ’ ) / ) 
READ (1 ,6065, ERR=6C 45) FSC 

6065  EORMAT (2 (1 X,2A4,A2,1X) ) 

GO  TO  6048 

6046  URITE(1,6056) 

6056  FORHAtd X, ’ENTER  RESPONSIBLE  ENGINEER ’,/, 3 (’ ! !’)/) 

READ(1,6066,ERR=6046)(NRE(1,J),J=1,3) 

6066  F0RMAT(3(1X,A3,1X)) 

6048  WRITE ( 1 , 60 25 ) P TI T , DLN , F SC , I OD ,COUNT , A THR, NRE, ADO 

6050  WRITE(fl)ATHR, DLN, PTIT.IDD, COUNT, ADD, FSC, NRE 

GO  TO  6010 

7000  CALL  SRCHSI (KSCLOS, »ACTD  ’,6,0, 0,0) 

CALL  SRCHU  (KSCLOS, ’REVS  »,6, 0,0,0) 

CALL  SRCHIS (K! DELE , »ACTD  ’,6, 0,0,0) 

CALL  CNAMIK’REVS  ’,6,’ACTD  ’,6,10 

CALL  SRCH$i(KSROUR4KJNDAH,’RFVS  ’,6,4,1,10 
RETURN 
END 
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SUBROUTINE  WHERE 

THIS  SUBROUTINE  PERFORKS  THE  FUNCTION  OF  CETERHINING 
WHICH  SUB-FILES  ARE  TO  BE  OPENED  FOR  USE. 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COMMON/BLK/  M S* ATHR , DD, TO » DLNt SUB , RCUT » I DD . CWA  ,CONT » 

1 AODiTWX»FSC»NRF, DDT, RtPTIT, COUNT, CON 
COHMON/SRC/  KNT,DM,DA,DDO,UTO,t)L,IT,D,WA,DW,OT,DRE 
1 ,TFVD,TLVD,FVD,LVD»IEX 

COMMON/ FLA/  I TRSP , I HELE , I TUFX , I ANN , IPR , I M I S , I R E AO 
INTEGEft*4.  ATHR(7),T0(8),DLN(5),SUE(21) ,ROUT( 6) ,PTIT(19)  , 

1 C0N(5)  , TUX  (6,5)  ,FGC(  (-)  ,NRE  (1 ,3)  ,ODT(  30,21  ),T(21) 

1 ,TIT(P4)  ,f;OUNT,C0NT  (5),IFX(4,3) 

INTEGER *2  MS, DD ( 3 ) , I DO ( 3 ) , ADD ( 3 ) , R , CU A ( 4 ) , UA (4 ) 

INTEGER»2  I TR SP , I HELE , I TUFX , I ANN , I PR , I M I S , I R EAD 
1NTEGER*2  F VD ( 3 ) , L V D ( 3 > , D ( 3) , DM , DDO ( 3 ) 

INTEGER *4  DR E , DT ( 5 ) , DU ( 5 ) , DL ( 5 > , D A ( 7 ) , I T ( 24 ) , DT 0 ( 8 ) , KNT 
DOUBLE  PRECISION  DT J , Tf , TL , T JUL , TFVP , TL VD, T I M ,T J 
SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NCLIST 

INTEGER*2  IOPT,IFILE 

INITIALIZE  ALL  SUB-FI LE  FLAGS  : 

ITRSP  REPRESENTS  THE  T R A NSM I TT AL /SPECI FI C ATION  SUB-FILE 

IHELE  REPRESENTS  THE  MEHO/LETTER  SUB-FILE 

ITUFX  REPRESENTS  THE  T WX/M AON AF A X/R API F A X SUB-FILE 

lANN  REPRESENTS  THE  ANNOUNCEMENT  SUB-FILE 

IPR  REPRESENTS  THE  PURCHASE  REQUEST  SUB-FILE 

IMIS  REPRESENTS  THE  M I SCELL ANEOUS /HEP OR T SUB-FILE 

ITRSP=0 

IMELE=0 

ITWFX=0 


lANN  =0 
IPR  =0 
IMIS  =0 

10  WPITF(1,100) 
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(1957J  lOO  F0RHAT(2X,*SUE  FILE  SELECT  I ON : ♦ » / * 2X» »1 . TR ANSH I TT AL/SPECIF I C ATI  0 
(1908)  IN  SUB-FILE'»/»2X»*2.  MEHO/LETTER  SUB-F I LE • « 2Xt 

(19593  1*3.  TWX/MAGNAFAX/RAPIFAX  SUB-F I LE » »/ . 2Xt M . ANNOUNCEMENT  SUB-FIL 

(1960)  1E*»/»2X,*5.  PURCHASE  REQUEST  SUB-F ILE • »/♦ PXt ♦ 6.  MISCELLANEOUS/’* 

(19£.l)  I’RI.PORT  SUB-FILr»*/*2X,3f.(  »**>  */*2X, 

(1962)  I’HOU  MANY  SUBFILES  DO  UISH  TO  OPEN*/) 

(1963)  C 

(196‘t)  C PERFORM  VALIDITY  CHECK  ON  USER  ENTRY 

(1965)  C 

(1966)  READ(1.110*ERR=10)IFILE 

(1967)  110  FDRHAT(I2) 

(1968*  IF ( IFILE.LE.O.OR.IFILE.GT.6)  GOTO  10  . 

(1969)  IFdFILE.FQ.  6)  GOTO  300 

(1970;  DO  2(30  1 = 1*6 

(1971!  115  URITF(l*12Ci)  I 

(1972)  120  FORMAT (2X* *!,0  YOU  WANT  SUB  FILF  NUMBER  **I2*»  (YES  OR  NO)*) 

(1973)  READ(1*130*ERR=115) lOPT 

(1979)  130  F0RMAT(1A2) 

(1975)  IFdOPT.EQ.'NO*)  GOTO  190 

( 1976)  IFdOPT.NE.  *YE*)  GOTO  115 

( 1977)  IFd.EO.l)  ITRSP=1 

(1978)  IFd.FQ.2)  II'ELE  = 1 

(1979)  IFd.EQ.3)  ITWFX=1 

(1980)  IFd.EQ.A)  lANN  =1 

(1981)  IFd.EG.5)  IPR  =1 

(1982)  IFd.EQ.6)  IMIS  =1 

(1985)  IF(IFILE.EQ.ITKSP*IMELE*-ITUFX*IANN*IPR*IHIS)  goto  500 

(198A)  190  CONTINUE 

(1985)  200  CONTINUE 

(1986)  GO  TO  500 

(1987)  300  ITRSP=1 

(19(18)  IMELE  = 1 

(1989)  ITUFX=1 

(1990)  lANN  =1 

( 1991 ) IPR  =1 

(1992)  IMIS  =1 

(1993)  500  IFdTRSP.EQ.l)  CALL  SR  CHJ  $ ( KIR  DWR  + KINOAH.  * TR  AN.  *.6*2*1*10 
(199A)  IFdMELE.EQ.l)  CALL  SRCH  $$  ( KIROUR  + KI ND  AH*  * MEMO  **6*7*1*10 
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(1995) 

IF(ITUFX.EQ.I) 

CALL 

SRCH$$(K$RDUR*KJNOAM» 

•TWFX 

(199$) 

IFdANN  .EQ.l) 

CALL 

SRCHSS(K$RDUR*KINDAM. 

•ANN 

(1997) 

IFdPR  .CG.l) 

call 

SRCHH(KJRDUR*K$NDAH» 

•PR 

( 199tJ) 

IFdMIS  .EQ.l) 

CALL 

SRrH:$(K$RPUR  + KlNOA)^, 

•MIS 

(1999) 

RETURN 

(2ono) 

END 
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lOPT 
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000009 

1938S 

1959M 

1981H 

1983 

1991M 

IREAD 
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1980  1981 

1996 
1998  A 


1999 

1998 

. 1997 


1993 

1995 
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KiCLOS  1 parameter 
KICONV  I PARAMETER 
KICURR  I PARAMETER 
KiOELE  I PARAMETER 
KJDMPB  I PARAMETER 
KJOTIM  1 PARAMETER 
KIENTR  I OOOOOO 

KlEXST  I PARAMETER 
K1G0:JD  I PARAMETER 
KiCPOS  I PARAMETER 
KIMOME  I PARAMETER 
KlICUR  I PARAMETER 
KMMFD  I PARAMETER 
XJIRTN  I PARAMETER 
KSIOEG  I PARAMETER 
KSIUFD  I PARAMETER 
XIME^JT  I OOOOOO 

Ktf'SIZ  I PARAMETER 
^ KlMVrJT  I PARAMETER 

C"  KIR'DAM  I PARAMETER 

KJ'iRTN  I PARAMETER 
KSNSAM  I PARAMETER 
KIMSGD  I PARAMETER 
KINSGS  1 PARAMETER 
KiPOSA  I PARAMETER 
KIPOSN  I PARAMETER 
KIPOSR  r PARAMETER 
Klf'REA  I PARAMETER 
KIPRER  I PARAMETER 
KIPROT  1 PARAMETER 
' KiP.rwR  I PARAMETER 
KSREAD  I PARAMETER 
KIRPOS  T PARAMETER 
KSRSUE  I PARAMETER 
KiRULK  I PARAMETER 
KiSENT  1 OOOOOO 

KISETC  I PARAMETER 
KSSETH  I PARAMETER 


1939S 
1939S 
1939R 
1939S 
1939S 
1939S 
1939E 
1939S 
1939G 
19  391. 

1939S 

1939', 

1939S 

1939S 

1939S 

1939S 

1939S 

1939S 

1939S 

193 9. S 1993  199A  1995  1996  1997 

1939' 

1939S 

1939S 

1939$ 

1939$ 

1939S 

1939$ 

1939$ 

1939S 

1939$ 

1939$  1993  199A  1995  1996  1997 

1939$ 

1939$ 

1939$ 

1939S 

1939$ 

1939$ 

1939$ 


1998 


1998 
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KSSPOS 

1 

parameter 

19  395 

KSSRTN 

I 

PARAMETER 

1939S 

KITRNC 

I 

PARAMETER 

19395 

KSUf’OS 

I 

PARAMETER 

1939S 

KIWRIT 

I 

PARAMETER 

19  391. 

KNT 

J 

/SRC/ 

000000 

19  3fiS 

LVD 

I 

/SRC/ 

000206 

19  3ft  5 

MS 

I 

/BLK/ 

000000 

193ftS 

NRE 

J 

/BLK/ 

000276 

193BS 

PT  IT 

J 

/ULK/ 

002661 

1936S 

R 

I 

/bLK/ 

002660 

19  3flS 

ROUT 

u 

/!LK/ 

000126 

1936S 

SRCMJS 

R 

EXTERNAL 

000000 

1993 

199A 

1995  1996 

1997  1998 

SUB 

J 

/I'LK/ 

00005A 

1938S 

T 

J 

000002 

193ftS 

TF 

0 

OOCOCO 

1938S 

TFVD 

0 

/SRC/ 

000173 

19  3f.S 

TIH 

0 

000000 

193B.F 

TIT 

J 

OOOOBA 

193BS 

TJ 

0 

000000 

1936S 

TJUL 

D 

000000 

1938.S 

TL 

0 

000000 

1938S 

TLVD 

D 

/SRC/ 

000177 

1938S 

TO 

J 

/BLK/ 

000022 

1938S 

TWX 

J 

/FLK/ 

000166 

1936S 

WA 

I 

/SRC/ 

OCOISI 

1936S 

WHERE 

R 

000000 

19355 

_io 

000151 

1956D 

1966 

1968 

_100 

000156 

1956 

19570 

110 

000^25 

1966 

1967D 

_115 

000A55 

1971D 

1973 

1976 

_120 

OOOA6A 

1971 

1972D 

_130 

000531 

1973 

1974D 

_IV0 

000635 

1975 

IPB'iO 

_200 

000635 

1970 

19850 

300 

nO06A3 

1969 

19870 

3oo 

000652 

1983 

1986 

19930 
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SUBROUTINE  OPEN 


<2001)  SUBROUTINE  OPEN 

(2002)  C THIS  SUBROUTINE  OPENS  ALL  SUB  PILES  FOR  READ/URITE 

(2003)  C SYSCOH>KEYS.F  BNEKONIC  KEYS  FOR  FILE  SYSTEM  (FTN) 

(2003)  NOLIST 

(2004)  CALL  SRCHSJ ( K$RDWR4KSNDAM» ‘TRAN  •«6t2«l*IC) 

<2006)  CALL  SRCHJI(K$RDUR+KlNnAH,*KEHO  »«6«7»1,IC) 

(2006)  CALL  SRCHSS <KJRDUR+KSNOAM,»TUFX  •«6*e.l,IC) 

<2007)  CALL  SRCHSS(KIRDUR  + KJNDAH,«ANN  •»f.»9il,IC) 

<2O0B)  CALL  SRCHSJ(KlRnUR+KSNCAM**PR  *»6*10»1,ID 

<2009)  call  SKCHSS  (KJRDUR  + KSNDAH, 'HIS  ’tf-tlltltlC) 

(2010)  RETURN 

(2011)  END 
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IC 

I 

000062 

200AA 

KSALLD 

I 

parahete:r 

2003S 

KICACC 

1 

PARAMETER 

2003S 

KiCLOS 

I 

PARAMETER 

2003S 

KtCONV 

I 

PARAMETER 

2003S 

KiCJRR 

I 

PARAMETER 

20C3S 

kice:ll 

I 

parameter 

20  03S 

K1  [IMPS 

X 

PARAMETER 

2003S 

KJDTIK 

I 

PARAMETER 

20  0:',S 

KSENTR 

I 

000000 

2003S 

K S i:  V S T ■ 

I 

PARAMETER 

2003S 

KiGONO 

I 

PARAMETER 

2003S 

KiGPOS 

I 

PARAMETER 

2003S 

KIHOHF 

I 

PARAMETER 

2003S 

KI  ICUR 

I 

PARAMETER 

2003S 

KilNFO 

I 

PARAMETER 

2C03r 

K 1 1 R T N 

t 

PARAMETER 

2003S 

KSISEG 

I 

parameter 

20  03S 

K J-IUFO 

1 

PARAMETER 

2003S 

:<1I'.FNT 

I 

000000 

20  03E. 

K IMF  1 2 

I 

PARAMETER 

2003S 

KIFVNT 

1 

PARAMETER 

2003S 

KINOAM 

I 

PARAMETER 

20  036 

KINRTN 

I 

PARAMETER 

2003E 

K1NSA8 

I 

PARAMETER 

2003S 

KJNSGO 

I 

PARAMETER 

2003S 

KJNSGS 

I 

P ARAMETER 

2003S 

KJPOSA 

I 

PARAMETER 

2003S 

KiPCSN 

I 

PARAMETER 

2003E. 

KiPCSR 

I 

PARAMETER 

20  03S 

K3  PRFA 

I 

PARAMETER 

2 0 0 3 S 

KJPRlR 

1 

PARAMETER 

2003S 

KiPROT 

I 

PARAMETER 

20  0 3S 

KIRDWR 

I 

PARAMETER 

2003S 

k;.re  AD 

I 

PARAMETER 

2003S 

KIRPOS 

I 

PARAMETER 

2003E. 

K3.RSUP 

I 

parameter 

2003F 

KiR'.LK 

I 

PARAMETER 

2003E 
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2006A  2007A  2008A  2009A 


2005  2006  2007  2008  2009 


2005  2006  2007  2008  2009 
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(2012) 

(2013) 

(201'») 

(201'i) 

(201b) 

(2016) 

(2017) 

(201f!) 

(2019) 

(2020) 

(2021) 

(2022) 
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SUBROUTINE  CLOSE 

C THIS  SUBROUTINE  CLOSES  ALL  SUB-FILES 

C SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY«  1977 

NOLIST 

CALL  SRCH1J(KJCL0S»*TRAN  •«6f0,0»0) 

CALL  SRCHI$(KICLOSt*MEMO  •,6«0*0»0) 

CALL  SRCHli (KSCLOS, ‘TWFX  *,6,0,0t0) 

CALL  SRCHSKKSCLOS, 'ANN  ♦,6,0«0»0) 

CALL  SRCH11(K$CL0S,«PR  *,6.0»0»0) 

CALL  SRCHtS (KSCLOS, »MI S ». 6. 0*0,0) 

RETURN 

END 
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CLOSE  R 000000  2012S 

KJ4LLD  I PARAMETER  201AS 

KlCACC  1 PARAMETER  2014S 

KiCLOS  I PARAMETER  201A.S  2015  2016  2017  2018  2019 

XICGNV  I PARAMETER  201'lS 

K5CURR  I PARAMETER  201'iS 

KIHELE  I PARAMETER  201AS 


KSOMPB 

I 

PARAMETER 

201  AS 

KIET IM 

I 

PARAMETER 

201A2 

KIEMR 

I 

000000 

201AS 

KlEXST' 

I. 

PARAMETER 

201AS 

KSGCM) 

I 

PARAMETER 

2D1AS 

KiGPCS 

I 

PARAMETER 

2C1AS 

KiHOME 

I 

PARAMETER 

201AE 

KSICUR 

I 

PARAMETER 

201AS 

KIIHFO 

1 

PARAMETER 

201  AS 

KilRTN 

1 

PARAMETER 

20  IAS. 

KSISEG 

I 

PARAMETER 

201  AS 

KSIUFD 

I 

PARAMETER 

201AS 

K1HENT 

I 

0000 00 

20'IAS 

KJMFIZ 

I 

P ARAMETER 

20  IA  S 

KSMVrjT 

I 

PARAMETER 

201AS 

KtNCAH 

I 

PARAMETER 

20.1  AS 

Kr.i\JRTN 

I 

PARAMETER 

201AS 

KSMSAM 

I 

PARAMETER 

201AS 

KSfJSGD 

I 

PARAMETER 

201  AS 

KI.VSGS 

I 

PARAMETER 

2P1AS 

KSPOSA 

I 

PARAMETER 

201AS 

KSr-OSM 

I 

PARAMETER 

201AS 

KIPCSR 

I 

P ARAMETER 

201AS 

KiPREA 

1 

parameter 

201AS 

KSPRER 

I 

PARAMETER 

201AS 

KtPROT 

I 

parameter 

201AS 

KlRnWR 

I 

PARAMETER 

201AS 

KIREAD 

I 

PARAMETER 

201AS 

KIRPOS 

I 

PARAMETER 

201AS 

KIR sue 

I 

PARAMETER 

201AS 

KJRWLK 

I 

PARAMETER 

POIAS 
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2020 
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SUBROUTINE  CLOSE 


KSSENT 

I 

000000 

20HS 

KiSETC 

I 

f^ARAHETER 

201AS 

K JSFTH 

1 

PARAMETER 

POIA  S 

KSSPOS 

I 

PARAMETER 

201AS 

KiSP.TN 

I 

PARAMETER 

POIAS 

K 1 T R N C 

I 

PARAMETER 

20  IAS 

KJUPOS 

I 

PARAMETER 

201AS 

KXWRIT 

I 

PARAMETER 

201AS 

SRCHSS 

R 

EXTERNAL  000000 

2015 

DOOO  ERRORS  KCLOSE  >FTN-R  EVl  R .2  3 


o<i 


2017  2018  2019  2020 
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(2023) 
<202‘i)  C 
(2025)  C 
(2C26>  C 
(2C27)  C 
(2028)  C 
(2028)  C 
(2L29)  C 
(2029)  C 
(2029) 
(2029) 
(2029) 
(2029) 
(2C29) 
(2029) 

□□  (2029) 

I (2029) 
(2029) 
(2029) 
(2029) 
(2029/ 
(2029) 
(2030)  C 
(2C31 ) 
(2032)  C 
(2033)  C 
(2038)  C 
(203t.) 
(2036)  10 

(2037) 
(2038) 
(2039) 

(2080  ) 
(2081)  POO 
(2082) 
(2083) 
(2088) 
(2085) 


SUBROUTINE  SHOWC 

THIS  SUBROUTINE  DISPLAYS  ON  THE  USER  TERMINAL  THE 
COMPLETE  DOCUMENT  RECORD  REPRESENTATION.  THIS  ROUTINE 
CAN  BE  CALLED  BY  INPUT  OR  REVISE  MODE  TO  CLARIFY  THE 
RECORD  BEING  USED  AT  HAND.  ITEMS  ARE  NUMBERED  FOR 
FURTHER  DEFINITION  OF  DATA. 

DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

COHMON/BLK/  MS» ATHR . DO  * TO  * DLN , SUB tROUT » I DO , CUA ,CONT» 

1 AOD»  TUX<FSC»NRE«DDT»R.PTI T»  COUNT,CON 

COHMON/SRC/  KNT,DHtOA»uCD,DTO,r!L*IT,D»WA.DW»DT,DRE 
1 .TFVO.TLVOtFVO.LVO.IEX 

COHHON/FLA/  I T RSP  ♦ I M FLC  . I TU’FX  , 1 ANN  . IPK  , IM  I S . I R F AD 
INTEGER*8  A THR ( 7) « T 0 ( 8 ) « DLN ( 5 ) , SUB ( 2 1 ) , ROUT ( 6 ) » P T IT < 1 9 ) » 

1.  COI.'(5),TUX(6,5),FSC(6),NRr(l»3)*ODT(30,21)»T(21) 

1 ,Tn(28),rOUNT*CONT(5),IEX(8*3) 

INTEGER*2  MS , DD ( 3 ) . I DO ( 3 ) « ADD ( 3 ) i R » CUA ( 8 ) . UA ( 8 ) 

INTEGER*2  I TRSP.  I ME  LE  . I T U'FX  ♦ I A RN  , IPR  , IN  IS  , I R E AD 
INTFGER*2  F VP ( 3 ) » L V D ( 3 ) , 0 ( 3) « DM, ODD ( 3 > 

INTEGER *8  0RE,DT(5),DW(5),DL(5),DA(7),IT(28),DT0(a),KNT 
DOUBLE  PRECISION  DT  J , TF  t TL,  T JUL  , TF  VD  , TL  VD,  T I f1,  T J 
CLEAR  USER  TERMINAL  SCREEN  FOR  OUPUT  DISPLAY 
CALL  CLEAR 

DISPLAY  RECORD 

URITEU ,10) MS, ATHR, DD»TO,DLN,SUB,ROUT,IDD,CWA,CONT, ADO 
F0RMAT(2X,M.  »,A2,11X,*2.  » , 7 A8  , / , 2X  , » 3 . • , 2 ( 1 2 , •- * ) , 1 2,5X,  *8  . », 
1 8A8,/,2X,*5.  • ,8A8 ,A2,/,2X, »6.  SUB JECT • , / , 3X , 7 ( 2 A8 , A2 , 1 X ) , / , 

1 2X,»7.  *,5(A3,'/»)  ,A3,5X,*e.  » ,2 ( 1 2,  •- * ) , 1 2 ,/ ,2 X, • 9 . »,8A2,5X, 

1 *10.  • ,5A8,5X, *11.  •,2(I2,»-»),I2) 

URITE(l,aoO) 

FORMATt’  12..  RFFERENCTD  DOCUMENT  NUMBER(S)t*) 

DO  810  M=l’,6 
KTU  = 0 

DO  820  N = 1 ,5 

IF  (TUX(H,N)  .NE.»  •)  KTU  = KTU-*1 


L. 


) 


) 
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(2046) 

620 

CONTINUE 

(2047) 

IF(KTU.EO.O)  GOTO  900 

(2048) 

URITE(1»B50)  (TWX(K,N),N=1,5) 

(2049) 

850 

FORMAT (5X,4A4,A2) 

(2C50) 

810 

CONTINUE 

(2051) 

900 

CONTINUE 

(2052) 

WRITEd  .100  0 )FSC 

(2051) 

1000 

FCRMAT(»  13.  *.  2A4,A2,*/»,2A4tA2> 

(2054 ) 

WRITEd  tl200  ) 

(2055) 

1200 

FORMAT!*  14.  FNGINFERS:*) 

(2C56) 

KRE  = C 

(2057) 

00  1400  L=lt3 

(2058) 

IF(NRE(liL).NE.»  *)  KRE=KRE*1 

(2059) 

1400 

CONTINUE 

03 

(2080) 

IF(KRE.rO.D)  GOTO  1050 

1 

(2061) 

WRITE(ltl70)  (NRE(1»L) »L=lt3) 

cr» 

(2062) 

170 

F0Rf1AT(5X,3(A3,lX)) 

CO 

(2063) 

1050 

CONTINUE 

(2064 ) 

IF(ITREP.EQ.O)  GOTO  1070 

(2065) 

WRITEd. 1100) 

(2066) 

1100 

FORMAT!*  15.  DESCRIPTION:*) 

(2067) 

DO  1500  1=1.30 

(2068) 

KOD  = 0 

(2069) 

00  1600  J=l,21 

(2070) 

IF  (DOT!  I.  J)  .NE  .*  *)  KDD  = KOD'*l 

(2071> 

1600 

CONTINUE 

(2072) 

IF(KOD.E«.0)  GOTO  1070 

(2073) 

URITEd.lRO)  (DDT(I,J).U  = 1,21) 

(2074? 

180 

F0RMAT(4X,7dX,2A4,A2>) 

(2075) 

1500 

CONTINUE 

(2076) 

1070 

CONTINUE 

(2077) 

RETURN 

(2078) 

END 
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ADO 

ATHR 

CLEAR 

CON 

CONT 

COUNT 

CUA 

0 

HA 

CD 

COD 

DOT 

PL 

DLN 

PM 

DRE 

PT 

DTJ 

OTO 

DU 

FSC 

FVD 

I 

lANN 

IDD 

lEX 

IMELE 

IMIS 

IPR 

IREAD 

IT 

ITRSP 

ITUFX 

J 

KDD 

KNT 

KRC 

KTU 


1 /PLK/ 

U /lLK/ 

R EXTERNAL 
J /BLK/ 

J /DLK/ 

J /BLK/ 

I /BLK/ 

I /SRC/ 

J /SRC/ 

I /BLK/ 

I /SRC/ 

J /BLK/ 

J /SRC/ 
d /ELK/ 

I /SRC/ 

J /SRC/ 
d /SRC/ 

D 

J /SRC/ 
d /SRC/ 
d /BLK/ 

I /SRC/ 

I 

I /FLA/ 

■I  /BLK/ 
d /SRC/ 

1 /FLA/ 

I /FLA/ 

I /FLA/ 

I /FLA/ 
d /SRC/ 

I /FLA/ 

I /FLA/ 

I 

I 

d /SRC/ 

1 

I 


000163 

2029S 

2035 

COOOOI 

20  2 9S 

2035 

. 000000 

2031 

002731 

202'’S 

000151 

202OS 

2035 

002727 

2029S. 

0001A5 

2029S 

2035 

000136 

20  29S 

000003 

2029S 

0 0001  7 

2029S 

2035 

000021 

2029S 

C0030A 

2029  S 

2070 

2073 

OOOOAA 

2029S 

0C00A2 

20  29S 

2035 

000002 

202‘.'S 

000171 

2029S 

000157 

2029S 

000000 

2029S 

00002A 

20  29S 

000145 

2029S 

000262 

2029S 

2052 

000203 

202'  S 

001017 

2067M 

2070 

2073 

000003 

2029  S 

000142 

20  2 9S 

2035 

000211 

202BS 

000001 

202'  S 

000005 

2029S 

000004 

2029  S 

000006 

2029S 

000056 

20  2 “ S 

000000 

2029S 

2064 

000002 

2029S 

001020 

20  69M 

2070 

2073H 

001021 

206PM 

2070M 

2072 

000000 

2029S 

001022 

2056M 

2058M 

2060 

001023 

2043M 

2045H 

2047 
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L 

I 

001024 

2057H 

2058 

2061H 

LVD 

I 

/SRd/ 

C00208 

202'’S 

M 

I 

00102b 

2042M 

2045 

2048 

r.s 

I 

/f'LK/ 

000000 

2029S 

2035 

N 

I 

001020 

2044H 

2045 

2048M 

NRE 

J 

/BLK/ 

000276 

2029S 

2058 

2061 

PTIT 

J 

/BLK/ 

002661 

2029S 

R 

I 

/BLK/ 

002660 

2029S 

ROU  7 

J 

/BLK/ 

000126 

2029S 

2035 

SHCUC 

R 

COOOOO 

2023S 

SUB 

J 

/r-LK/ 

000054 

2029S 

2035 

T 

J 

000002 

2029S 

TF 

D 

OOOOOO 

2026S 

TFVO 

D 

/SRC/ 

000173 

2029S 

TIM 

0 

OOOOOO 

2026S 

TIT 

U 

000054 

2029S 

TJ 

D 

COOOOO 

202'\S 

TJUL 

0 

OOOOOO 

20  29S 

TL 

0 

OOOOOO 

2029S 

TLVD 

0 

/SRC/ 

000177 

20  29S 

TO 

J 

/BLK/ 

000022 

2029S 

2035 

TUX 

J 

/BLK/ 

000166 

2029S 

2045 

2048 

VA 

I 

/SRC/ 

000141 

20  2VS 

10 

000203 

2035 

2036D 

_1C00 

000530 

2052 

PD53D 

IlCiiO 

000655 

2060 

20630 

10  70 

001012 

2064 

2072 

20760 

_1100 

OC0665 

2065 

20660 

_1200 

000553 

2054 

20550 

1400 

000610 

2057 

20590 

_1£'00 

CC1004 

2067 

20750 

_1600 

000732 

2069 

20710 

..17  0 

000645 

2061 

20620 

_180 

000772 

2073 

20740 

_800 

000365 

2040 

204  10 

_81Q 

C00512 

2042 

2050D 

.820 

000443 

2044 

20460 

SUBROUTINE  SHOUC 


850  000503  2048  2C49D 

“900  000520  2047  2051D 

0000  ERRORS  C<SHOWC  >FTN-REV14,23 


00 

I 

cn 

(Tt 
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'CL 


(2079) 

(2060) 

<2081) 

. (2082) 
(2083) 
(2083) 
(2063) 
(2063) 
(2083) 
(2083) 
(2083) 
(2083) 
(2083) 

. (2083) 
(2063) 
“ (2083) 

—I  (2083) 
5 . <2083) 
(2083) 
(2063) 
<2i;8't) 
, (2C8A) 

(2085) 
(2086) 
(2087) 
(2088) 
(2089) 
(2090) 
(2091) 
(2092) 
(2093) 
(2099) 
(2095) 
(2096) 
(2097) 
(2098) 
(2099) 
(2100) 


SUBROUTINE  ALC 

C THIS  SUBROUTINE  PERFORMS  THE  SEARCH  OF  ALL  HAIL  LOG 

C SUB-FILES 

C SELECTED  SUB-FILES  CAN  BE  ELIMINATED  FROM  SEARCH 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

C 

COMMON /ELK/  HS»  ATHR , DD » T 0 1 DLN» SUB  * ROUT , I DD * CWA  « CONT t 
1 AD0,TWX,FSC,NRE,DUT,R,PT1T,C0UNT*C0N 

COHHON/SKC/  KNT»DHtDA,DDDtOTO,nLin ♦D»UA*OU»DT»DRE 
1 ♦TFVn»TLVDtFVD,LVD«irX 

COHHON/FLA/  ITRSP,IHELE,ITWFX,IANN,IPR,IMIS.IREAD 
INTEGER*9  A THR ( 7) , TO ( 8 ) , DLN ( 5 ) . SUB ( 2 1 ) , R OUT ( 6) »PT I T ( 19 ) » 

1 C0N(5)«Tl!X<6.5) »FSC(6) ,NRt ( 1*3) tDDT( 30 ,21) tT(21 ) 

1 ,TIT(29)  ,C0UNT,C0NT(‘j),irX(9,3) 

INTEGER*?  MS,  DD(3  ) * 10D(  3)  , AL’D<  3)  ,R  ,CUA  (9  ) * WA  (9  ) 

INTEGER*?  lTRSP,IMLLE,IT.(FX,IANM,IPr:,IHIS,IREAD 
INTEGER*?  FVD(3),LVP(3),D(3),DM,nDD<3) 

INTEGER*9  DR  E , 0 T(  5 ) , DL’ < 0 ) , DL  ( 6 ) , D A ( 7 ) , I T ( 29  ) , DTO  ( 8 ) , KNT 
DOUBLE  PRECISION  DT  J , T F , TL  , T JUL  , TF  VI),  TL  VD,  T I H , T J 
C SYSC0M2KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY,  1977 

NOLIST 

INTEGER*?  IPAGF,IPR1MT 
C INITIALIZE  FOUND  COUNTER 

KNT=0 

C INITIALIZE  FIRST  FOUND  FLAG 

IPAGE=C 

C INITIALIZE  TOP  OF  PRINTER  PAGE  FLAG 

IPRINT=0 
URITE(1,1) 

1 FORMAT!*  THIS  IS  THE  PRINT  ALL  ROUTINE*,/, 

1*  ALL  DOCUMENTS  IN  THE  HAIL  LOG  FILE  WILL  BE  PRINTED*,/) 

CALL  BREAKS! .TRUE. ) 

C READ  ALL  SELECTED  SUB-FILES 

50  CALL  RDSUB 

C IS  THE  SEARCH  OF  ALL  APPROPRIATE  SUBFILES  COMPLETED 

IF(IREAD.EO.l)  (.OTO  100 

C IS  THIS  THE  FIRST  RECORD  FOUND  ‘ . 
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(2101) 
(2102) 
(2103) 
(210A) 
(210b) 
(21C6) 
(2107) 
(2106) 
(2109) 
(2110) 
(2111) 
(2112) 
(2113) 
(211A) 
(211 5) 
(2116) 
(2117' 
(211P) 
(2119) 
(2120 ) 
(2121) 
(2122) 
(2123) 
(212A) 
(212b) 
(2126) 
(2127) 


IF  (IPAGE.NE.O)  GOTO  160 

C SET  UP  FOR  DISPLAY  OF  THE  PRINT  ALL  HEADING 

ITEM=50 
IPAGE  = 1' 

C DISPLAY  HEADING  ON  USER  TERMINAL  SCREEN 

CALL  SCRNhO(ITEM) 

C DISPLAY  RECORD  FOUND  ON  USFR  TERMINAL  SCREEN 

160  CALL  SCRNPT(ITFH) 

C IS  THIS  FOR  TOP  OF  PRINTER  PAGE 

IF(IPRINT.NF.O)  GOTO  170 

C PRINT  HEADING  FOR  PRINT  ALL  ON  PRINTER 

CALL  HARDHD( ITEM) 

IFRINT=1 

C PRINT  RECORD  FOUND  ON  PRINTER  ■ 

170  CALL  HAP.OPT(ITEM) 

C IS  THIS  BOTTOM  OF  PRINTER  PAGE,  YES  SET  TOP  OF  PRINTER  PAGE  FLAG 

lF(KNT/22.EG.KNT/22.)  IPRINT=0 
GO  TO  50 

C CLOSE  ALL  SUB-FILES 

100  , CALL  CLOSE 

C CLOSE  ALL  OTHER  OPEN  WORKING  FILES 

CALL  SRCHIJ (KSCLOS, 'OUT  »,6, 0,0,0) 

CALL  SRCHS$(K$CLOS, »REVS  *,6,0, 0,0) 

CALL  SRCHli (KJCLOS, ’DATE  », 6, 0,0,0) 

CALL  C0MI$$(’S0UT*,4,12,IC) 

CALL  EXIT 
END 
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J 

/ELK/ 

002727 

20  83S 
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000042 
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DM 

I 
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2083S 
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2083S 

DT 

J 
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2083S 

DTJ 
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2083S 
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2083S 

DU 
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2083S 

EXIT 
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000000 
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J 
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1 

/FLA/ 

000005 

20  83S 

IC 

1 

000556 

2125A 

IDO 

I 

/ELK/ 

000142 

2083S 

lEX 

J 

/SRC/ 

000211 

20  83S 

IMELE 

I 

/FLA/ 

000001 

2083S 
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IT 
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000361 
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KSALLD 
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PARAMETER 
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KSCACC 
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2123 

2124 

KSCONV 

I 

PARAMETER 

POSAS 

KICURR 

I 

PARAMETER 

208AS 

KiDFLE 

I 

PARAMETER 

208AS 

KSDMPB 

I 

PARAMETER 

208AS 

KJDTIM 

I 

PARAMETER 

208AF 

KSENTR 
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2084S 

KIFXST 

I 

PARAMETER 

2084S 

KIGOMD 

I 

PARAMETER 

20848 
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I 
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I 
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PARAMETER 
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I 
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I 

PARAMETER 
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I 
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2084S 
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I 

PARAMETER 
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« 

KIPOSA 

I 
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2084S 
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I 

PARAMETER 

2084S 
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I 

PARAMETER 

2064? 

KSPKEA 

I 

PARAMETER 

2084S 

KSPRER 

I 

PARAMETER 

2084? 

K JPROT 

I 

PARAMETER 

2084? 

KiR jUR 

I 

PARAMETER 

20845 

K JRFAD 

I 

PARAMETER 

2084? 

* 
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KIP.POS 

I 

PARAMETER 

2084S 

KSRSUB 

1 
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2084S 
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I 
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I 
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I 
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J 
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I 
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MS  • 

I 
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20P.3S 
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J 
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2C83S 

PTIT 

J 

/UK/ 

002&B1 

2083S 

R 

I 

/'  LK/ 

002660 

2083S 

RDSUB 

R 

EXTERNAL 

POOOOO 

2097 

ROUT 

J 
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000126 

20H3S 

SCRMHD 

R 

EXTERNAL 

000000 

2106 

$CR.\PT 

R 

EXTERNAL 

0000 00 
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SRCHSS 

R 

EXTERNAL 

000000 

2122 

SUB 

J 

/ULK/ 

00006A 

2083S 

T 

J 

C00002 

2083S 

TF 

D 

nooooo 

2083S 

TFVD 

D 

/SRC/ 

000173 

2083S 

TIM 

D 

000000 
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TIT 

J 

000054 

2083S 

TJ 

D 

000000 
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TJUL 
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000000 

20R3S 

TL 

D 

000000 
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TLVD 

D 
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TO 

J 
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TUX 

J 
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UA 

I 
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1 
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CO 


(2?.2eJ 

(2129) 

(2130) 

(2131) 

(2131) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2132) 

(2133) 

(213A) 

(2135) 

(2130 

(2137) 

(2138) 

(213S) 

(2180) 

(2181) 

(2182) 

(2183) 

(2188) 

(2185) 

(2186) 

(2187) 

(2188) 

(2189) 


SUBROUTIHE  SEAC 
COMMON  /COAT/CO 
DOUBLE  PRECISION  CD 

C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY*  1977 

NOLIST 
C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 
C 

COHHON/BLK/  MS,  ATHR  , OD  « T 0 , DLN  * SUB  i ROUT,  I DD  » CU'A  ,CONT, 

1 ADD, TWX,FSC,NHE, DOT, R,PTIT, COUNT, CON 
COHMON/SRC/  KNT ,DM,DA,DDD,DT0,UL,IT,D,UA,DU,0T,DRE 
1 ,TFVO,TLVU,FVD,LVO,IEX 

COMMON /FLA/  ITRSP,IMELE,ITUFX,IANN,IPR,IMIS,IREAO 
INTEGER»8  ATHR  ( 7)  , T 0 ( 8 > , DLN  ( 5 ) , 5.  Un  ( 2 1 ) , ROUT  ( 6)  , PT 1 T ( 19  ) ♦ 

1 C0f.(5),TWX(6,5) ,FSC(8) ,NRF(1 ,3) ,0DT(30,21),T(21) 

1 ,TIT(28) , COUNT, C0NT(5) ,ItX(8,3) 

INTF.GER*2  MS  , DO  ( 3 ) , I DO  ( 3 ) , A I)D  ( 3 ) , R , CWA  ( 8 ) , U A ( 8 ) 

INTFGER*2  ITRSP,IMFLE,ITUFX,1ANN,IPI<,IHIS,IRLAD 
. INTEGER'2  F VD( 3 ) ,LVD( 3) ,0(3) ,py ,000(3) 

INTEGER«8  D!vF,DT(5),DU(5),DL(5),OA(7),IT(28),DTO(8),KNT 
DOUBLE  PRECISION  DT J , Tf , T L , T JUL , T F V 0, TL VD, T I H , T J 
INTLGER*2  IDES(2),10PT 
INTLGER*8  COUNTR 
C 

e THIS  IS  THE  SEARCH  DRIVER  ROUTINE  FOR  THE  HAIL  LOG  FILE 

C 

C CLEAR  USER  TEKKIN/L  SCREEN  FOR  DISPLAY 

CALL  CLEAR 

C OPEN  OUTPUT  FILE  TO  BE  SPOOLED  IF  A HARD  COPY  IS  DESIRED 

CALL  SRCHJ$(K$RDUR  + KINSAM,*CUT  *,6,3, 0,0)  . 

J=:801 

URITE(7,9999) J 
9999  F0RMAT(1A2) 

C DISPLAY  SEARCH  MODES ( OPT  I ONS) 

URITE(1,1) 

1 FORMAT!*  YOU  ARE  NOW  VALIDATED  TO  SEARCH  DATA  IN  THE  •,/ 

1*  HAIL  LOG  FILE  - THE  FOLLOWING  SEARCH  MODES  *,/ 

1*  ARE  AVAILABLE  FOR  YOUR  USE  - »,/  ' 
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(2150) 

1*mode: 

KEY*,/ 

(2151) 

I’HAIL  STATUS 

MS',/, 

(2152> 

i*author/source: 

AUTH',/, 

(2153) 

I'COCUHLNT  date: 

DOC',/, 

(215A> 

1 •to/adore:sse:e:. 

TO',/, 

(2155> 

1 •docuhent/le:tte:r  number 

DLN',/, 

(2150) 

1‘SUPJECT 

SUB',/, 

(2157) 

1‘INPUT  data  date 

lOD*,/, 

(216fi) 

1»U.A.  NUMREP/ID  CODE 

CWN',/, 

(2159) 

1 'CONTRACT  NUMBER 

CON',/, 

(2160) 

I'ACTION  ITEM  DUE  DATE 

ADD',/, 

(2161) 

1 'R ( SPONSIBLE  ENGINEER 

NPE* ,/, 

(2162) 

I'ALL 

ALL',/ 

(2163) 

I'GUIT 

QUIT*,/ 

(2164) 

1'  PLEASE  SELECT  THE  DESIRED  MODE**//) 

(2165) 

6 

READ(1,3)I0ES 

(2166) 

3 

FORMAT (1A2»A1 ) 

(2167) 

IF  (lOES(l) .EQ.'OU*)  GO  TO  10 

(21C6) 

REWIND  10 

(2169) 

C 

IS  THIS  THE  FIRST  TIME 

THRU  SEARCH  ROUTINE 

(2170) 

IF(IRR.EQ.l)  GO  TO  2000 

(2171) 

50 

WRITE(1,20Q1) 

(2172) 

20  01 

FORMATE'  PLEASE  INPUT  THE  CURRENT  0 ATE  ' « /. 'MMODY Y »/ ) 

(2173) 

READ(1»2002,ERR=50) 1M,ID 

'lY 

(2174) 

2002 

F0RMAT(3I2) 

(2175) 

REWIND  10 

(2176) 

READ(10,2005)COUNTR 

(2177) 

2005 

F0RMAT(8X,I3) 

(217(0 

C 

STORE  THE  CURRENT  DATE 

(2179) 

REWIND  10 

(2180) 

WRITE(10,2003)IH,IDtIYfCOUNTR 

(2181) 

2003 

F0RHAT(1X»3I2.1X,I3) 

(2102) 

REWIND  10 

(2183) 

C 

CONVERT  CURRENT  DATE  TO 

JULIAN  TIME 

(2.184) 

CALL  JTIHE(IY,IM,ID*0*0» 

0,CD) 

(2185) 

C 

SET  FIRST  TIME  THRU  SEARCH  ROUTINE  FLAG 

(2186) 

IRR  = 1 

(2187) 

C 

IS  THIS  A ROUTINE  THAT 

USES  A SPECIFIC  TIME  FRAME 

) ) 
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<218R)  C to  BE  SEARCHED*  YES  PERFORM  SUBROUTINE  BRAKE! 

(21R9)  2000  IF(IDES{l).NE.*AL».AND.I0rS(l).NE.»00*.AND.I0ES(l).NE.’ID* 

<2190)  1 .ANO.IDES(l>.NE.»AD*)  CALL  DRAKE! 

<2191)  C INITIALIZE  THE  READ  SUBFILES  COMPLETE  FLAG 

<2192)  IREAD=0 

<2193)  C IS  THIS  AN  ACTION  DUE  DATE  SEARCH 

<219A)  IF(IDES(1).EC.»AD*I  GOTO  99 

(219S)  C DETERMINE  SUB  FILES  TO  BE  OPENED  FOR  SEARCH 

<2196)  CALL  UHERE 

<2197)  C DETERMINE  SEARCH  MODE  TO  RE  CALLED 

<219B)  ■ IF  (IDESd  ) .FQ.»  AL» ) CALL  ALC 

<2199)  IF (IDESn ) .EQ. 'NR*)  CALL  RESEA 

<2200)  IF(IDES(l).f Q.*TO*)  CALL  WHO 

<2201)  IFUDESd)  .EG.’DO*  ) CALL  DDAT 

<2202)  IF(IOEE(l).EQ.*CO»)  CALL  CNUM 

jjg  (2203)  IF(ICES(1).EQ.»CU»)  CALL  CWAID 

I <220A)  IF(IDES(1).EG.»AU»)  CALL  AUSEA 

— <2205)  IF<IDES(l).EQ.*OL»)  CALL  DLSEA 

^ (2206)  IF  ( IDES (1) ,EO. »ID* > CALL  DATC 

AJ  (2207)  IF(IDES(1).FG.»SU»)  CALL  SUBJ 

(2208)  IF(IDES(l).EO.M-S*)  CALL  KSTAT 

(2209)  99  IF(IDES(l).EO.*AD»)  CALL  ADAT 

(2210)  100  WRITF(1*101) 

(2211)  101  FORMAT(*  •,/,»  IF  YOU  WISH  TO  CONTINUE*  DEPRESS  THE  RETURN*/) 

(2212)  RLAD(1.3)IDi:S 

(2213)  I F { IDES (1) .ME . * *)  GOTO  100  ' 

(221A)  URITE(1*1> 

(2215)  C 

(2216)  C CLOSE  ALL  OPEN  SUREILFS 

(2217)  C 

<2210  CALL  CLOSE 

<2.219)  GO  TO  6 

(2220)  10  WRITE(1*11) 

(2221)  C 

(2222)  C CLOSE  TEMPORARY  OUTPUT  FILE 

(2223)  CALL  SRCHIS (KJCLOS* *OUT  **6*0*0*0) 

(222A)  11  FORMAT(*  DO  YOU  WANT  A HARD  COPY  OF  THE  INFORMATION  FOUND**/* 

(2225)  II  (YES  OR  NO)*) 
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<2226) 

(2227) 

(2228) 

(2229) 

(2230) 

(2231) 

(2232) 

(2233) 

(2236) 

(2238) 

(2236) 

(2237) 
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READ(1»5) lOPT 

3 F0RMAT(1A2) 

IF(ICPT.EO.»YE»)  GO  TO  20 
1F(I0PT.EQ.*N0»)  GO  TO  15 
GO  TO  10 

15  CALL  SRCH$$(K$DELE* 'OUT  •«6,0«D»0) 

RETURN 

20  CALL  SPCHIt (KSCLOSt »DA TE  *»6, 0,0*0) 

CALL  SRCHIJ.  (KSCLOS, ‘REVS  •, 6, 0,0,0) 

CALL  COKI 3 $( 'ECUT • ,6,12, IC) 

CALL  EXIT 
END' 


) 


) 
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AOAT 

R 

EXTERNAL 

000000 

2209 

ADD 
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/blk/ 

000163 

2132S 

ALC, 

R 

EXTERNAL 

000000 

219R 

ATHR 

J 

/ILK/ 

000001 

2132S 

AUSEA 

R 

EXTERNAL 

000000 

220A 

BRAKE! 

R 

EXTERNAL 

cooooo 

21P9 

CD 

D 

/CDAT/ 

000000 

2129S 

CLEAR 

R 

EXTERNAL 

000000 

21  3''' 

CLOSE 

R 

EXTERNAL 

000000 

221> 

CNUM 

R 

EXTERNAL 

ococoo 

2202 

COKISS 

R 

EXTERNAL 

000000 

2235 

CON 

J 

/l-LK/ 

002731 

2132S 

CO  NT 

J 

/l.LK/ 

OOOlbl 

2132S 

COUNT 

J 

/BLK/ 

002727 

2132S 

COUNTR 

J 

001A53 

213AS 

CWA 

I 

/ELK/ 

0001A5 

2132S 

CUAID 

n 

EXTERNAL 

000000 

2203 

0 

1 

/SRC/ 

000136 

2132S 

DA 

J 

/SRC/ 

000003 

2132S 

DATC 

R 

EXTERNAL 

000000 

2206 

DD 

I 

/I’LK/ 

000017 

2132S 

DDAT 

R 

EXTERNAL 

000000 

22  01 

ODD 

I 

/SRC/ 

000021 

2132S 

DOT 

J 

/ELK/ 

00030A 

2132S 

DL 

J 

/SRC/ 

OOOOAA 

2132S 

DLN 

J 

/BLK/ 

OOOOA2 

2132S 

DLSEA 

R 

EXTERNAL 

000000 

2205 

DM 

I 

/SRC/ 

OC0OO2 

2132S 

DRE 

J 

/SRC/ 

000171 

2132S 

DT 

J 

/SRC/ 

000157 

2132S 

DTJ 

D 

OOOOOO 

2132S 

OTO 

J 

/SRC/ 

00002A 

2132S 

DU 

J 

/SRC/ 

0 001  AS 

2132S 

EXIT 

R 

EXTERNAL 

600000 

2236 

FSC 

J 

/ELK/ 

000262 

2132S 

F VD 

I 

/SRC/ 

000203 

0132S 

I ANN 

I 

/FLA/ 

000003 

2132S 

IC 

I 

001A61 

2235A 

2130S 


2176M 


21R4A 


21P0 
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ID 

I 

001462 

2173H 

2180 

IDD 

I 

/ELK/  000142 

2132S 

IDES 

I 

000002 

2133S 

2165H 

2200 

2201 

2207 

2208 

lEX 

J 

/SRC/  000211 

2132S 

IN 

I 

001463 

2173H 

2180 

IHELE 

I 

/FLA/  000001 

2132S 

IMIS 

I 

/FLA/  OOOOOS 

2132S 

lOPT 

I 

001464 

2133S 

2226M 

IPR 

I 

/FLA/  000004 

2132S 

IKEAD 

I 

/FLA/  000006 

2132S 

2192M 

IRR 

J 

C01465 

2170 

P186M 

IT 

J 

/SRC/  000056 

2132S 

ITRSP 

I 

/FLA/  000000 

2132S 

ITfFX 

I 

/FLA/  000002 

213PS 

IT 

1 

G01466 

2173M 

2180 

J 

I 

001467 

2142H 

2143 

jtime 

I 

EXTERNAL  000000 

2184 

KSALLD 

I 

PARAMETER 

2131S 

KSCACC 

I 

PARAMETER 

PT31S 

KSCLOS 

I 

PARAMETER 

2131S 

2223 

KICONV 

I 

PARAMETER 

2131S 

KSCURR 

I 

PARAMETER 

2131S 

KJDFLE 

I 

PARAMETER 

2131S 

2231 

KSDMPB 

I 

PARAMETER 

2131S 

KSOTIH 

I 

PARAMETER 

2131S 

KIENTR 

I 

000000 

2131S 

KCEXST 

I 

PARAMETER 

2131S 

KSGONU 

1 

PARAMETER 

2131S 

KSCPOS 

I 

P ARAHFTER 

2131S 

KSHOHE 

I 

PARAMETER 

2131S 

KSICUR 

I 

PARAMETER 

2131  S 

KJIHFD 

I 

PARAMETER 

2131S 

KSIRTN 

I 

PARAMETER 

2131S 

KlISEG 

I 

PARAMETER 

2131S 

KSIUFD 

I 

PARAMETER 

2131S 

KiMENT 

I 

000000 

2131S 

) 


PAGE 


2184A 

2167 

2202 

2209 

2189 

2203 

2212H 

2194 

2204 

2213 

2198 

2205 

2199 

2206 

2184A 

2228 

2229 

21SAA 


2233  2234 


) 
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KSMSIZ 

I 

f»ARAriETER 

2131S 

KSMVNT 

1 

PARAMETER 

2131S 

KINDAM 

I 

PARAMETER 

2131  S 

KXNRTN 

I 

PARAMETER 

2131S 

KSNSAM 

I 

PARAMETER 

2131S 

2141 

KSNSGC 

I 

PARAMETER 

2131S 

KTNSGS 

I 

P ARAMETER 

2131S 

KSPOSA 

I 

PARAMETER 

2131S 

KIPOSN 

1 

P ARAMETER 

21316 

KJPOSR 

I 

PARAMETER 

2131S 

KSPREA 

I 

PARAMETER 

2131S 

KIPKFR 

I 

P AK AMf  TER 

2131S 

KJPROT 

I 

PARAMETER 

2131  S 

KSRL'WR 

I 

PARAMETER 

2131S 

2141 

KIREAD 

I 

PARAM.t  TEH 

2131  S 

KIRPOS 

I 

PARAMETER 

2131S 

KSRSUB 

I 

PARAM.ETER 

2131S 

KiRWLK 

1 

PARAMETER 

2131S 

KSSENT 

I 

000000 

2131S 

KiSETC 

I 

PARAMETER 

2131S 

KSSETH 

I 

PARAMETER 

2131  E 

KJSPOS 

1 

P ARAMETER 

2131S 

KSSP.TN 

I 

PARAMETER 

2131  6 

KTTRNC 

I 

PARAMETER 

2131S 

KSUPCS 

I 

PARAMETER 

2131S 

KlURIT 

I 

PARAMETER 

2131S 

KNT 

J 

/SRC/  000000 

2132E 

LVD 

I 

/SRC/  000206 

213PS 

MS 

I 

/L-UK/  000000 

2132S 

MS  TAT, 

I 

EXTERNAL  OOOCOO 

22  0 0 

ARE 

J 

/ELK/  000276 

2132S 

PTIT 

J 

/ELK/  002661 

2132S 

R 

I 

/ELK/  002660 

2132S 

RESEA 

R 

EXTERNAL  UOOOOO 

2199 

• 

s'. 

ROUT 

J 

/ELK/  000126 

2132S 

, 

SEAC 

R 

000000 

212RS 

SRCMSS 

R 

EXTERNAL  GOOOGO 

.?!  A1 

2223 

2231 

2233 

223A 

sun 

J 

/ELK/  00005A 

2132S 
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SUBO 

R 

external 

000000 

2207 

T 

J 

000004 

2132S 

TF 

D 

OOOOOO 

2132S 

TFVD 

D 

/SRC/ 

000173 

2132S 

TIM 

D 

OOOOOO 

2132S 

TIT 

J 

OOOObO 

2132S 

TJ 

0 

OOOOOO 

2132S 

TJUL 

D 

OOOOOO 

2132S 

TL 

0 

OOOOOO 

21  32S 

TLVD 

D 

/SRC/ 

000177 

2132  6 

TO 

J 

/BLK/ 

000022 

2132S 

TUX 

J 

/BLK/ 

000166 

2132S 

UA 

1 

/SRC/ 

000141 

2132S 

WHERE 

R 

EXTERNAL 

OOOOOO 

2196 

WHO 

R 

EXTERNAL 

OOOOOO 

2200 

_1 

000174 

2146 

2147D 

-10 

001304 

2167 

2220D 

100 

001217 

22100 

2213 

_101 

001223 

2210 

2211D 

_11 

001320 

2220 

22240 

C01412 

2225 

22310 

_2  0 

001424 

222R 

2233D 

_2  000 

001060 

2170 

21090 

2001 

000720 

2171 

21720 

_2C02 

000767 

2173 

2174D 

_2003 

001033 

21R0 

21810 

_2C05 

001004 

2176 

21770 

_3 

000671 

216b 

21660 

“s 

001375 

2226 

22270 

_5  0 

000714 

21710 

2173 

6 

000661 

21650 

2219 

_99 

001213 

2194 

22090 

_9999 

000163 

2143 

21440 

0000  ERRORS  CCSEAC  >FTN-REV1A.2 3 
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TO 

00 


(2238) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(2239) 
(22A0) 
(22A0) 
(2291  ) 
(2292) 
(2293) 
(2299) 
(2295) 
(2296) 
(2297) 
(2298) 
(2299) 
(2250) 
(2251) 
(2252) 
(2253) 
(2259) 
(2255) 
(2256) 
(2257) 
(2258) 
(2259) 


SUBROUTINE  ARCC 

t 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

C 

COMMON /ELK/  MS, ATHR * DD, T 0 . DLN ♦ SUB *ROUT * I DD » C WA  tCONT« 

1 AD0.TUX,FSC,NRE.DDT,R,PTIT,C0UNT«C0N 
^ COMHON/SRC/  KNT.DH,OA,nUDfDTO,PL»IT,DtUAfDW,DT,DRE 
1 tTFVD»TLVDtFVD,LVD,IEX 

COHHON/FLA/  I TRSP , I MELE , I T WF X» I A NN , IPR , IH IS , IRE AD 
INTEGER*9  ATHR (7) « T0(8 ) » DLN(5) *SUB( 21 ) tROUT( 6) *PTIT (19) t 
1 C0N(5),  U’X(6,5)  ,FSC(6) tNRE(l,3) tDDT(30,21) »T(21) 

1 »TIT(29),r0UNT,C0NT(5)»ILX(9,3) 

INTEGER *2  MS , DO (3 ) , I OD ( 3 ) , APD ( 3 ) , R » C UA ( 9 ) , UA ( 9 ) 

INTEGER *2  IT RSP , I ME LE » T TUF X, I A NN , IPR , I H I S » IRE AD 
INTEGER*2  F VO ( 3 ) , L V [•  ( 3 ) » D ( 3 ) ♦ DM . ODD ( 3 ) 

INTEGER «9  DRE«DT(5)iDU(5).0L(5)iDA(7)tlT(29),DT0(B)tKNT 
DOUBLE  PRECISION  DT  J , TE  ♦ TL  * TOLL  « TFVL't  TL  VD»  T I H*  T J 
C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY»  1977 

NOLIST 

INTEGER*9  ICOUN 
INTECER*2  A(15) ,IN, I ANS 
C 

C THIS  IS  THE  ARCHIVE  ROUTINE  FOR  THE  HAIL  LOG  FILE 

C NOTE:  THIS  IS  LIMITED  ACCESS 

C 

C VALIDATE  THE  INCOHHING  USER 

C 

CALL  TIHDAT(A,15) 

IF(A(13).NE.*GY»)  GO  TO  700 
GO  TO  750 

700  URITE(1,701) 

701  FORMAT(*GGSORRY  YOU  ARE  NOT  VALIDATED  TD  USE  THIS  ♦./♦ 

1*R0UTINE.  IF  IT  IS  NEEDED  PLEASE  CONTACT  YOUR  SYSTEM'*/* 

1'  OPERATOR  AT  EXT.  2621'/) 

RETURN 

750  CONTINUE 
C 

C WHICH  HAIL  LOG  DOCUMENT  IS  TO  HE  ARCHIVED 
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(2260) 

C 

KEY  ON  THE  INPUT  DATE  AND  COUNT  CODE  NUMDER 

(2261) 

C 

(2262) 

3 

URITE(1»1) 

(2263) 

(226A) 

1 

FORHATC  PLEASE  ENTER  THE  INPUT  DATE  AND  COUNT  CODE  ** 
l*OE  THE  OOCUKF.NT  TO  RE  AR  CH I VE  D » » / . • ! ' « f,X,  • ! ! * * 3 X»  * ! • ) 

(226b) 

READ(1.2.rRR:5)0,IC0UN 

(2266) 

2 

F0RMAT(1X,3 I2.2X,I3) 

10 

WRlTE(l.ll) 

(226B) 

(2265) 

(2270) 

(2271) 

(2272) 

11 

FORKAT(*  UHICH  SUBFILE  IS  THIS  DOCUMENT  LOCATED:**/* 

1 6X**1.  TR ANSHITTAL/SPECIFICATION  2.  HEHO/L ETTER • * /* 

1 6X**3.  TUX/KAGNAFAX/KAPIFAX  A.  ANNOUNCEMENT**/* 

1 6X**5.  PURCHASE  REQUEST  6.  MI SCEL LAN FOUS /REPORT */ ) 

READ ( 1 *12) IANS 

(2273) 

(227A) 

(2276) 

(2276) 

(2277) 

12 

F0PHAT(I2) 

IF(IANS.GT.6.0R.IANS.LT.l)  GOTO  10 
IF(IANS.GE.2)  GOTO  300 

CALL  SHCHSS (KJRDUR+KSNDAM* *TRAN  **6*2*liIC) 
CALL  SKCHSl (K1R0WR+K$N0AH**INACTL»*6*5*1*IC) 

(2278) 

(2276) 

(2280) 

15 

FEAD(9*ENO=20)MS*ATHR,DD*TO*OLN*SUB*PTIT* 

1 ROUT  * I DD* COUNT *CUA»CONT* ADD* TVX*FSr,NRE. DOT 
GO  TO  15 

(2281) 

(2282) 

20 

CONTINUE 
REWIND  6 

(2263) 

100 

READ(6*LNO=2CO)HS*ATHR*DD*TO*OLN*SUB*PTIT» 

(228(1) 

(2286) 

(2286) 

(2287) 

1 RCUT*inD*COUNT*CUA»COMT*ADD*TWX,FSC*NRE*DDT 
IF(COUNT.NF.ICOUN)  GOTO  125 
DO  110  1=1.3 

IF(IDO(I).NE.D(I))  GO  TO  125 

(2283) 
(2283) 
(2290) 
(2291  ) 

110 

CONTINUE 

WRITE (9)MS*ATHR*OD.TO*OLN»SUB*PT1T*ROUT* 
1 I1)D*C0UNT*CUA,C0NT*ADD*TUX*FSC,NRC*DDT 
GOTOlOO' 

(2292) 

(2293) 

(229A) 

125 

WRITE(t<)MS.  ATHR*DD*TO,nLN*SUn*PTIT,ROUT* 
1 IDt)*CCUNT*CWA*CONT*ADD*TUX.FSC*NRE*ODT 
GO  TO  100 

(2295) 

(229b) 

(2297) 

200 

ENDFILE  8 
ENDFILE  9 

CALL  SRCHSJ (KICLOS* *REVS  ♦,6*C*0*0) 

) 
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(229P) 
(2299) 
(2300) 
(2301) 
(2302 ) 
(2303) 
(230't) 
(230b) 
(2306) 
(2307) 
(2308) 
(2309) 
(2310) 
(2311) 
(2312) 
(2313) 
(2314) 
(2315J 
(2316) 
(2317) 
(2318) 
(2319) 
(2320) 
(2321) 
(2322) 
(2323) 
(232A) 
(232b) 
(2326) 
(2327) 
(2328) 
(2329) 
(2330) 
(2331) 
(2332) 
(2333) 
(2334) 
(233b) 


call  SRCHJKKSCLOS,  •INACTL*t6.0«0,0) 

CALL  SRCHJl (KtCLOS. *TRAN  •i6»0*0»0) 

CALL  SRCHS$(K$DELEi 'TRAN  •»b»0»0*0) 

CALL  CNAHJK’REVS  *,6«»TRAN  •tbfIC) 

GO  TO  500 
C 

C ARCHIVE  SUBFILES  2 THRU  6 

C 

300  IF(  IANS.E0.2  ) CALL  SRCHSl  ( K$R  D'JR  + K IND  AH  * •HEHO  ‘.GfTflflC) 
IF(IANS.E&.3)  CALL  SRCH $ S ( K tRD WR+K* ND A«» • TUFX  •«6»8,1»IC) 
IF(I ANS.E0.4)  CALL  SRCHT $ ( K JR DUR+K tND AM, » ANN  •»6, 9,1,10 

IF(I  ANS.EQ.5)  CALL  SRCH II  ( KSRO  L'R +K  tNO  AM  , • PR  ♦, 6, 10,1,10 

IFdANS.EQ.6)  CALL  SRCHJ I ( K IRD  VR  *K  J NO  AM  , 'H 1 S ♦,6,11,1,10 

CALL  SR CHJI (KIR DWR  + KI NO AM, 'INACTS*, 6,5,1,10 
315  READ(9,END=320)MS, ATHR,DD,TO,DLN,SUO,PTIT, 

1 ROUT,I nO,CCUNT,CUA,CONT,ADD,TUX,FSC,NRE 
GO  TO  315 
320  CONTINUE 

IN=IANE+9 

REWIND  IN  ' 

35  0 READ(  IN,EMD=4r>0)MS,  ATHr<,DO,TO,OLN,SUR,PTIT, 

1 ROUT, IDD, COUNT ,CW A, CONT, ADD, TUX, FSC,NRE 
IF(CCUNT.NE.ICOUN)  GOTO  AOO 
CO  390  1=1,3 

IF (IDD(  I) .NE.O ( I) ) GO  TO  AOO 
390  CONTINUE 

URITE(9)MS, ATHR,DD,TO,DLN,SUB,PTIT,ROUT, 

1 IDO, COUNT, CWA,CONT, ADD, TUX, FSC,NRE 
GO  TO  350 

AOO  UPITE(a)HS,ATHR,DD,TO,DLN,SUB,PTIT,ROUT, 

1 IDD, COUNT, CUA, CONT , ADD, TUX, FSC,NRL 
GO  TO  350 
450  ENDFILF  R 
ENDFILE  9 

CALL  SRCH$$(KtCLOS,»REVS  *,6,0, 0,0) 

CALL  SRCH1J(K$CLOS,*INACTS',6,0,0,0) 

IFdN.NE.ll  ) GOTO  «55 

CALL  SRCHI$(K$CLOS, 'MEMO  *,6,0, 0,0) 
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(2336) 

(2337) 

(2338) 

(2339) 
(2340  ) 
(234  1 ) 
(2342) 
(2343) 

455 

(2344) 

(2345) 

460 

(2346) 

(2347) 

(2348) 

(2349) 

465 

DO 

1 

(2350) 

(2351) 

(2352) 

(2353) 

(2354) 

(2355) 

(2356) 

(2357) 

(2358) 

470 

(2359) 

475 

(2360  ) 
(2361 ) 

460 

(2362) 

(2363) 

(2364) 

500 

CALL  SPCH1J(K$DELF» ‘MEMO  . •tf>*0»0«0) 

CALL  CNAHtlCREVS  ♦,6,»HFK0  »»f>,IC) 

GO  TO  5C0 

IFdN.NT.lR)  GOTO  AGO 

CALL  SFCHSS(Kjr.LOS,*TUFX  •.6»0,0,0> 

CALL  SPCHIJCKtOFLEi *TWFX  **6.0, OtO) 

CALL  CNAH1$(*REVS  ‘.G.’TWFX  'tG.IO 

GO  TO  500 

IF(IN.NE.13)  GOTO  A65 

CALL  SKCHSJ (KICLOS, *ANN  ». 6*0, 0,0) 

CALL  SRCHTKKIDFLE,  *ANN  *,6,0, 0,0) 

CALL  CNAKTICRFVC  »,6,»ANN  *,6,IC) 

GO  TO  500 

IF(IN.NF.IA)  GOTO  A70 

CALL  SRCHI.$(KICL0S,  *PR  *,6,0, 0,0) 

CALL  SRCHIS(KSDELE , *PR  *,6,0, 0,0) 

CALL  CNAM1J(*REVS  *,6,*PR  *,6,IC) 

GO  TO  500 

IF(IN.NE.15)  GO  TO  475 

CALL  SfiCHJKKSCLOS,  *HIS  *,6,0,  0,0) 

CALL  SKCH$$(KSDFLE , *HIS  *,6,0, 0,0) 

CALL  CNAfm(*RFVS  *,6,*MIS  *,6,IC) 

GO  TO  500 
WRITE(l,4P.O) 

FORMAT!*  AN  FRROR  IN  FILE  MANAGEMENT  SYSTEM  HAS  OCCURRED!*,/ 
1,*  PLEASE  CALL  OPERATOR  FXT.2f.21*) 

CALL  SRCH$J(K5RrUR-*KSNnAH,*REVS  *,6,4,1,10 

RETURN 

END 
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A 

1 

000002 

2242S 

2249A 

2250 

ADD 

I 

/BLK/ 

000163 

2239S 

2278H 

2283M 

2289 

2292 

2312M 

2318M 

2324 

2327 

ARCC 

R 

000000 

22  38  S 

ATHR 

J 

/DLK/ 

000001 

2239S 

2278H 

2283H 

2289 

2292 

2312M 

2318K 

2324 

2327 

CMAHIS 

R 

EXTERNAL 

000000 

2301 

2337 

2342 

2347 

2352 

2357 

CON 

J 

/BLK/ 

002731 

223RS 

CONT 

J 

/bLK/ 

000151 

2239S 

2278M 

2283H 

2289 

2292 

2312M 

2318M 

2324 

2327 

COUNT 

J 

/BLK/ 

002727 

2239S 

2278M 

2283M 

2285 

2289 

2292 

2312M 

2318  M 

2320 

2324 

232!7 

CUA 

I 

/bLK/ 

0001R5 

2239S 

22  78M 

2283M 

2289 

2292 

2312K 

2318H 

232  4 

2327 

D 

I 

/SRC/ 

000136 

2239S 

2P65H 

2287 

2322 

DA 

J 

/SRC/ 

000003 

2239S 

DD 

I 

/BLK/ 

000017 

2239S 

2278M 

228, 3M 

2289 

2292 

2312H 

231  8H 

2324 

2327 

ODD 

I 

/SRC/ 

000021 

2239S 

DDT 

J 

/BLK/ 

00030R 

2239S 

2278M 

2283H 

2289 

2292 

DL 

J 

/sac/ 

000044 

2239S 

DLN 

J 

/DLK/ 

C00042 

2239S 

2278M 

2283H 

2289 

2292 

2312M 

2318H 

2324 

2327 

DM 

I 

/SRC/ 

000002 

2239S 

ORE 

•J 

/SRC/ 

000171 

2239S 

DT 

J 

/SRC/ 

000157 

2239S 

DTJ 

0 

CCOOOO 

2239S 

DTO 

J 

/SRC/ 

000024 

223VS 

OW 

J 

/SRC/ 

000145 

2239S 

FSC 

J 

/ELK/ 

000262 

2239S 

2278M 

2283M 

2289 

2292 

2312M 

2318H 

2324 

2327 

FVD 

I 

/SRC/ 

000203 

2239S 

1 

I 

002365 

22B6M 

2287 

2321H 

2322 

I ANN 

I 

/FLA/ 

000003 

2239S 

* 

IANS 

I 

002366 

2242S 

2272M 

2274 

2275 

2306 

2307 

2308 

2309 

2310 

2316 

IC 

I 

002367 

P276A 

2277A 

2301 A 

2306A 

2307A 

230RA 

2309A 

2310  A 

2311A 

2337A 

2342A • 

2347A 

2352A 

2357A 
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2362A 

ICOUN 

U 

002370 

22A1S 

. 2265H 

2285 

2320 

IDD 

I 

/BUK/  0001A2 

2239S 

2278M 

2283H 

2287 

2289 

231E.M 

2322 

232A 

2327 

lEX 

J 

/SRC/  000211 

2239S 

IMLI.E 

I 

/FLA/  000001 

2239S 

IMIS 

I 

/FLA/  000005 

2235S 

IN 

I 

002372 

22A2S 

2316H 

2317 

2318 

2334 

,"3A9 

235A 

IPR 

I 

/FLA/  DOOOOA 

22  39  5 

IREAD 

I 

/FLA/  OOOOOA 

2239S 

IT 

J 

/ERC/  000056 

223"G 

ITRSP 

I 

/FLA/  000000 

2239S 

ITWFX 

I 

/FLA/  000002 

2239  S 

• 

KSALLD 

I 

PARAMETER 

22A0S 

KtCACC 

I 

PARAMETER 

22A0S 

KICLOS 

I 

PARAMETER 

22A0S 

2297 

2298 

2299 

2332 

23A0 

23A5 

2350 

2355 

KSCONV 

I 

PARAMETER 

22A0S 

KSCURR 

I 

PARAMETER 

22ACS 

KIDELE 

I 

PARAMETER 

2240S 

2300 

2336 

23A1 

2346 

KSDf’PB 

I 

PARAMETER 

22A0S 

K$CTIM 

I 

PARAMETER 

22A0S 

KSEfJTR 

I 

000000 

22ACS 

KIEXST 

I 

PARAMETER 

22A0S 

KiGOND 

I 

PARAMETER 

22A0S 

KIGPOS 

I 

PARAMETER 

22  A OS 

KSHOME 

I 

PARAMETER 

22A0S 

KilCUR 

I 

PARAMETER 

22A0S 

KJ  IF.FO 

I 

PARAMETER 

22A0S 

KlIRTN 

I 

PARAMETER 

22A0S 

KJISEG 

I 

PARAMETER 

22A0S 

KJIUFD 

I 

PARAMETER 

22A0S 

KiME.NT 

I 

000000 

22A0S 

KIMSIZ 

I 

PARAMETER 

22A0S 

KiXVNT 

I 

P AkAMETER 

22A0S 

KSNDAM 

I 

PARAMETER 

22A0S 

2276 

2277 

2306 

2307 

2310 

2311 

2362 

) 
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2292  2312M 


2339  23A* 


2333  2335 


2351  2356 


2308  2309 


4 I 
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KSNRTN 

1 

PARAMETER 

22A0S 

KSNSAK 

I 

PARAMETER 

2240S 

KSNSGD 

I 

PARAMETER 

2240S 

KSNSGS 

1 

PARAMETER 

2240S 

KJPOSA 

I 

PARAMETER 

2240S 

KSPOSN 

I 

PARAMETER 

r'240S 

KJPOSR 

I 

parameter 

2240S 

KiPREA 

I 

PARAMETER 

2240$ 

KIPRER 

I 

PARAMETER 

2240*; 

K JPKOT 

I 

PARAMETER 

:'24  0S 

KSRijUR' 

I 

PARAMETER 

22  4 n s 

2276 

2277 

2306 

2307 

2308 

2310 

2311 

2362 

KIRE  AD 

I 

PARAHt  TER 

224  OS 

KJRPCS 

I 

PARAMETER 

224  OS 

KSRSUL' 

I 

PARAMETER 

22  4 OS 

KiP'JLK 

I 

PARAMETER 

2240  S 

K$SC.fJT 

1 

000000 

224  OS 

KSr.ETC 

I 

PARAMETER 

2240S 

KSSrTH 

I 

PARAMETER 

2240S 

KISFOS 

I 

PARAMETER 

2240S 

KSSRTN 

I 

PARAMETER 

2240S 

KSTRNC 

I 

PARAMETER 

2240S 

KSUPOS 

I 

PARAMETER 

2240S 

K$URIT 

I 

PARAMETER 

2240  S 

KNT 

J 

/SRC/  000000 

22  3SS 

LVD 

1 

/SRC/  000206 

2239S 

MS 

I 

/bLK/  000000 

223SS 

2278M 

2283M 

2289 

2292 

2312M 

2324 

2327 

NRE 

J 

/ELK/  000276 

2239S 

2278H 

2283M 

2289 

2292 

2312M 

2324 

2327 

PTIT 

J 

/ELK/  002661 

2239S 

2278M 

2283H 

2289 

2292 

2312H 

2324 

2327 

R 

I 

/ELK/  002660 

2239E 

ROUT 

J 

/hLK/  000126 

2239S 

227RM 

2283M 

2289 

2292 

2312M 

2324 

2327 

SRCHtS 

R 

EXTERNAL  000000 

2276 

2277 

2297 

2298 

2299 

2300 

2307 

2308 

2309 

2310 

2311 

2332 

2335 

2336 

2 34  0 

2341 

2345 

2346 

2309 


2318M 

2318H 

2318H 

2318M 

2306 

2333 

2350 
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2351 

2355 

2356 

2362 

SUB 

U 

/BLK/ 

000054 

2239S 

2278  M 

2283M 

2289 

2324 

2327 

T 

J 

000021 

2239  S 

TF 

D 

000000 

2239S 

TFVD 

D 

/SRC/ 

000173 

2239S 

TIH 

D 

000000 

223SS 

TI^^DAT 

R 

EXTERNAL 

OOOQOO 

2249 

TIT 

J 

000073 

2239  6 

TJ 

0 

000000 

22396 

TJUL 

D 

000000 

2239S 

TL 

D 

000000 

223"S 

TLVO 

D 

/SRC/ 

000177 

2239S 

TO 

J 

/FLK/ 

000022 

2239S 

2278H 

2283M 

2289 

'324 

2327 

TWX 

J 

/P.LK/ 

000160 

2239S 

2278M 

2283H 

2289 

•’324 

2327 

WA 

I 

/SRC/ 

000141 

22  39  6 

1 

000302 

2262 

2263D 

”io 

000412 

2267D 

2274 

100 

000751 

2283D 

2291 

2294 

~11 

000416 

2267 

22680 

_110 

001064 

2206 

22800 

_12 

000607 

2272 

22730 

_125 

001162 

2285 

2287 

2P92D 

000655 

2270C 

2280 

2 

000402 

2265 

22660 

_2  0 

000747 

22  78 

22810 

_2  0 0 

001252 

2283 

22950 

3 

000276 

2262D 

2265 

^300 

001327 

2275 

23060 

~315 

001437 

2312D 

2314 

~320 

001525 

2312 

23150 

_350 

001533 

2318n 

2326 

2329 

^390 

001643 

2321 

23230 

_4  00 

001737 

2320 

2322 

2327D 

450 

002024 

2318 

23300 

\ 

/ 
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_A55 

002105 

233A 

23390 

_A60 

0 021A.2 

2339 

23AAD 

_A65 

002200 

23A4 

23A90 

Ia70 

002235 

23A° 

235A0 

_A7‘j 

002272 

235A 

23590 

_A0  0 

002277 

2359 

23600 

~500 

00235A 

23  0 2 

2330  2343  234fl 

2353 

2358 

23620 

”700 

000105 

2250 

22520 

_701 

000172 

22  5 2 

22530 

~7S0 

000276 

2251 

225711 
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(2365) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2366) 

(2367) 

(2367) 

(2366) 

(2369) 

(2370) 

(2371) 

(2372.) 

(2373) 

(237<») 

(2375) 

(2376) 

(2377) 

(2378) 

(2379) 

(2380) 

(2361) 

(23b2) 

(2383) 

(236‘t) 

(2385) 

(2386) 
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SUBROUTINE  UPDATE 
C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  HAIL  LOG  FILE 

C ‘ 

COHHON/BLK/  HS, ATHR ♦ OD t TO ,DLN , SUB tROUT , I DD »CWA ,CONT « 

1 ADD* TWX,FSCfNHE*DDT,R,PTIT, COUNT, CON 
COMHCN/SRC/  KNT,DH,DA,nDD,DTO,DL,IT,D,UA,DU,DT,DRE 
1 ,TFVD,TLVD,FVD,LVD,lrX 

COMMON/FLA/  I TR  SP  , I MFLE  , I T'.'FX  , I ANN,  IPR  , IH  I R , I R E A D 
_ INTFGER»A  A THK ( 7 ) , T 0 ( 6 ) , DLN ( 5 ) , SUB ( 2 1 ) ,R OUT ( 6 ) ,PT I T ( 1 9 ) , 

1 C0N(5),Tl.'X(6,b)  ,FSr(6),NUf  (1  ,3),DDT(30,21),T(21) 

1 ,TIT(2R),rOUNT,CONT(5),IEX(A,3) 

INTEGER»2  MR , OD ( 3 ) , I DO ( 3 ) , ADO ( 3 > , R , CWA ( R ) , UA ( A ) 

INTfGER*2  ITRSP,IMFLE,TTUFX,IANN.IPR,IMIS,IREAD 
INTFGER*2  F VD ( 3 ) , L V D ( 3 ) , D ( 3) , CM, ODD ( 3 ) 

INTEGER*  A pr'F,DT(5)  , DU  ( 5 ) , DL  ( 5 ) , DA  ( 7 ) , IT  ( 2 A ) , DTO  ( 8 ) , KNT 
DOUBLE  PRECISION  D T J, TF , T L, T JUL, TFVD , TL VD, T IM , Td 
C SYSC0M5KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER*2  FINISH 

INTEGER*A  DPT ( 1 9 ) , OE ( 1 ,3 ) , DF ( 6 > , KT 
REWIND  9 
REWIND  8 
FINISH=0 
DO  600  J=l,6 

IF(TUX(d,l).EQ.»  »)  GO  TO  600 
100  READ(9,ENO=300)DA,DL,OPT,D,KT,DDD,DF,OE 
IF(FINISH.EO.l)  GO  TO  200 
DO  105  K=l,5 

IF(TWX(J,K)  .NE.DL(K))  GOTO  200 
105  CONTINUE 
F1NISH=1 
DO  150  L=l,21 

IF(SUf)(L)  .L0.»DELA»)  C0T0160 
150  CONTINUE 

DO  155  L=l-21 

IF(SUB(L) .EQ.*APPR*.0R.SUB(L) .EQ.*DISA*.OR.SUB (L) .EQ.»01SP») 

1 GOTO  100 
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(2387) 

199 

CONTINUE 

(2388) 

GO  TO  200 

(2389) 

160 

WRITEd, 165)000 

(239  0) 

165 

FORMATUXt’ACTION  DUE  OAT  E : • . 2X  .2  ( 1 2t  • - • ) » 1 2 ♦ 

(2391) 

1 IX, ‘ENTER  NEW  OUE  DATE  (IF  NONE,  REPEAT  OLD  DATE)*/) 

(2392) 

KEAO(1,170,ERR=160)DDD 

(2393) 

170 

F0RBAT(312) 

(239A) 

IF(LDD(1> .LE.O.OR .000(1 ) .GE. 13)  GOTO  160 

(2399) 

IF (000(2) .LE.O. OR. 000(2) ,GE. 32)  GOTO  160 

(2396) 

200 

URITr(8)DA,OL,DPT,D,KT,DOU,DF,OE 

(2397) 

GO  TO  ICO 

(2398) 

300 

CALL  Sf  CHtKKJCLOS,  *ACTD  *»6, 0,0,0) 

(2399) 

CALL  SRCHIKKSCLOS,  »REVS  », 6, 0,0,0) 

(2A00) 

CALL  SHCHJ$(KIDELE,*ACTD  *,6,0, 0,0) 

(2  A Cl) 

CALL  CNAH1I(»REVS  •,r,*ACTC  *,6,IC) 

(2A02) 

CALL  SRCHJ$(KIROUR*K$NDAH,*ACTD  *,6,5,1,10 

(2A03) 

CALL  SRCHSt(KtRCWR+KSNDAH,»PEVS  *,6,A,1,IC) 

( 2 A 0 A ) 

REWIND  B 

(2A05) 

REWIND  9 

(2A06) 

FINISH=0 

(2A07) 

600 

CONTINUE 

(2A08) 

60  5 

READ(9,END=700)  D A ,DL, DPT ,D,K T, DOD ,OF,DE 

(2A09) 

GO  TO  605 

(2A10) 

700 

RETURN 

(2A11) 

END 
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ADO 

1 

/DLK/ 

000163 

2366S 

ATHR 

J 

/dlk/ 

000001 

2366S 

CNAHSS 

R 

EXTERNAL 

000000 

2401 

CON 

J 

/DLK/ 

002731 

2366S 

CONT 

J 

/FLK/ 

000151 

2366S 

COUNT 

J 

/pLK/ 

002727 

23  6 6 S 

CJA 

I 

/DLK/ 

000145 

2366S 

D 

1 

/SRC/ 

000136 

2366S 

2375M 

2 396 

240fiM 

OA 

J 

/SRC/ 

000003 

2366S 

2375M 

2 396 

2408H 

DO 

I 

/FLK/ 

000017 

23  60S 

ODD 

I 

/SRC/ 

000021 

236f,S 

2375M 

2389 

2392H 

24  08M 

DOT 

J 

/DLK/ 

000304 

2366S 

,DE  . 

J 

000002 

2369S 

2375M 

2396 

2408M 

DF 

J 

000010 

2369S 

2375H 

2396 

2408M 

DL 

J 

/SRC/ 

000044 

2366S 

2375K 

2378 

2396 

DLN 

J 

/BLK/ 

000042 

2366S 

OH 

1 

/SRC/ 

000002 

2366S 

DPT 

J 

000024 

2369S 

2375H 

2396 

2408H 

ORE 

J 

/SRC/ 

000171 

2366S 

DT 

J 

/SRC/ 

000157 

2366S 

DTJ 

D 

000000 

2366S 

DTO 

J 

/SRC/ 

000024 

2366S 

DU 

J 

/SRC/ 

000145 

2366E 

FINISH 

I 

001010 

236PS 

P372H 

2376 

2380M 

FSC 

J 

/DLK/ 

000262 

23  66S 

FVD 

I 

/SRC/ 

000203 

2366S 

I ANN 

I 

/FLA/ 

000003 

2366S 

IC 

I 

001012 

2401  A 

2402A 

2403A 

IDD 

I 

/DLK/ 

000142 

23  66S 

IFX 

J 

/SRC/ 

0 00  21,1 

P366S 

IMf.LE 

I 

/FLA/ 

000001 

2366S 

IMIS 

I 

/FLA/ 

000005 

2366S 

IPR 

I 

/FLA/ 

000004 

2366S 

IREAD 

I 

/FLA/ 

0tf<l0  0 6 

2366S 

IT 

J 

/SRC/ 

0 00  056 

2366S 

ITRSP 

I 

/FLA/ 

000000 

23f  6S 

ITWFX 

I 

/FLA/ 

000002 

2366S 

) 
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2394  2395  2396 


2408H 


2406M 
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J 

I 

001013 

2373H 

2374 

2378 

K 

I 

OOlOlA 

2377H 

2378 

KJALLO 

I 

PARAHETER 

2367S 

KlCACC 

I 

PARAMETER 

?3b7S 

KSCLOG 

I 

PARAMETER 

2367  5, 

2398 

2399 

KJCONV 

I 

PARAMETER  • 

2367G 

KJCURR 

I 

PARAMETER 

2367S 

Kirr.LE 

I 

PARAMETER 

?367S 

2400 

KSDMP8 

I 

PARAMETER 

P367S 

KJDTIH 

I 

PARAMETER 

P367S 

KJ ENTR' 

I 

000000 

2367S 

KJEXST 

I 

PARAMETER 

236  7S 

KICOND 

I 

PARAMETER 

P367S 

K JCPOS 

I 

PARAMETER 

2367S 

KIH.OME 

I 

PARAHETER 

2367S 

KSICUR 

I 

PARAMETER 

2367S 

KJ IMFD 

I 

PARAMETER 

2367S 

K$  IRTN 

1 

f»/RAMETER 

2367S 

KlifeEG 

1 

PARAHETER 

2367S 

KIIUFD 

I 

PARAHETER 

2367S 

KSMCNT 

I 

OOOOOO 

2367S 

Klf'SIZ 

I 

PARAMETER 

236  7S 

KJKVNT 

I 

PARAHETER 

2367S 

KJNOAM 

I 

PARAHETER 

2367S 

24  02 

2403 

KSNRTN 

I 

PARAHETER 

23f.7S 

KJNSAH 

I 

PARAMETER 

23675, 

KINS GO 

I 

PARAHETER 

2367S 

KINSGS 

I 

PARAMETER 

23676 

KSPOSA 

I 

PARAHETER 

;367£ 

KSPOSN 

I 

PARAHETER 

2367S 

KSPOSR 

I 

PARAMETER 

2367S 

KIPREA 

I 

PARAHETER 

2367S 

KiPPER 

I 

PARAMETER 

2367S 

KSPKOT 

I 

PARAMETER 

2367S 

KIRDUR 

I 

PARAMETER 

2367S 

2402 

2403 

KIHEAD 

I 

PARAHETER 

2367S 

KSRPOS 

1 

P At;  AM E TER 

2367S 

KSPSU13 

I 

PARAMETER 

2367E 
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ksrIjlk 

I 

parameter 

2367S 

KSSENT 

I 

cooooo 

2367S 

KSSETC 

I 

PARAMETER 

?367S 

KSSETH 

1 

PARAMETER 

2367S 

KSSPOS 

I 

PARAMETER 

23  67S 

■ KISRTN 

I 

PARAMETER 

2367S 

KITRNC 

I 

PARAMETER 

2367S 

KSUPOS 

1 

PARAMETER 

23  6 7?; 

KSWRIT 

I 

PARAMETER 

?367S 

KNT 

J 

/SRC/ 

000000 

2366S 

KT 

J 

001015 

?369S 

2375M 

L 

1 

001017 

238ir. 

2382 

LVD 

I 

/SRC/ 

000206 

2366S 

MS 

I 

/f-LK/ 

000000 

?3  66  S 

NRf 

J 

/BLK/ 

000276 

?36f  S 

PTIT 

J 

/RLK/ 

002661 

2366S 

CD 

R 

1 

/PLK/ 

002660 

2366S 

1 

ROUT 

J 

/I  LK/ 

000126 

2366  S 

SRCHSS 

R 

EXTERNAL 

000000 

2396 

2399 

SUR 

J 

/ELK/ 

00005* 

23  66S 

?382 

T 

J 

000072 

2366S 

TF 

D 

GOCOOO 

2366S 

TFVD 

D 

/SRC/ 

000173 

2366S 

TIM 

D 

000000 

23  6 6 S 

TIT 

■J 

CCOIAA 

2366S 

TJ 

0 

000000 

?366S 

TJUL 

0 

000000 

2366  S 

TL 

D 

000000 

2366S 

TLVD 

D 

/SRC/ 

000177 

2366S 

TO 

J 

/ELK/ 

000022 

23  66S 

TUX 

J 

/DLK/ 

000166 

2366S 

2374 

UPDATE 

R 

000000 

2365S 

UA 

I 

/SRC/ 

OOOlAl 

2366S 

_100 

00025? 

2375D 

2385 

_105 

0 00  3.4  3 

2377 

23790 

150 

GQ0370 

2381 

23B3D 

155 

000450 

2384 

23870 

2396  2A0RH 
23RAM  2385 


2A00  2A02 

2385 


2378 

2397 


2A03 
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160 

000456 

2382 

2389D 

165 

000466 

2389 

2390D 

_17Q 

000557 

2392 

2393D 

_2  00 

000613 

2376 

2378 

_300 

000650 

2375 

239BD 

_600 

000737 

2373 

2374 

_605 

000747 

2408D 

2409 

700 

001005 

2408 

241  OD 

0000  ERRORS  C <UPDATE>FTN-R EVl R . 2 3 
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03 

I 


(2412) 
(2413) 
(2414) 
(2414) 
(2414) 
(24)4) 
(2414) 
(2414) 
(2414  ) 
(2414) 
(2414) 
(2414) 
(2414) 
(2414) 
(2414) 
(2414) 
(2414) 
(2414) 
(2415) 
(2415) 
(241&) 
(2417) 
(2418) 
(2419) 
(2420) 
(2421) 
(2422) 
(2423) 
(2424) 
(2425) 
(242(.) 
(2427) 
(2428) 
(2429) 
(2430) 
(2431) 
(2432) 
(2433) 


SUBROUTINE  INPTC 

COMMON  /FlIOBF/IBUF ( :3046) 

C 

C DATA  DECLARATION  AND  COMMON  BLOCK  FOR  THE  MAIL  LOG  FILE 

C 

COrMON/DLK/  MS, ATHR,DO»TO,DLNf PUB»ROUT»IPD»CWA tCONT » 

1 ADD, TUX, FSCfNRF, DDT, RfPTIT, COUNT, CON 

COMMON/SRC/  KNI ,DM,DA ,DDD,DTO,DL,IT,D,UA,DU,DT,DRE 
1 ,TFVD,TLVD,FVD,LVD,irX 

COMHON/FLA/  I TRSP , I MELE , I TUFX , I ANN , IPR , IMI S , IR E AD 
■ INTFGER*4  A THR ( 7) ,TO ( P ) , DLN ( 5 ) ,SUB ( 2 1 ) ,R OUT ( t ) ,P T IT (19 ) , 

1 CON(5),TUX(6,r)),FSC(f>),NRr(l,3),DDT(30,21),T(2D 

1 ,TIT(24),rOUNT,CONT(5),IEX(4,3) 

INTEGER*2  M S, DD ( 3 ) , I DD ( 3 ) , ADD ( 3) , R , CUA ( 4 ) , UA ( 4 ) 

INTEGER«2  I TRSP , I ME LE , 1 TUFX , I A NN , IPP , I M I S, I R EAD 
INTEGEK»2  F VD ( 3 ) , L VD  ( 3 ) , D ( 3)  , DM,,DDD  ( 3 ) 

INTFGER*4  D RE , D T ( 5 ) , DU ( 5 ) ,DL ( 5 ) , DA ( 7) , I T( 24 ) , DTO ( fi) , KNT 
DOUBLE  PRECISION  D T J ,TF , T L ,T JUL , TF VO , T LVD, T IK , T J 
C SYSC0M>Kf YS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER*4  COUNTR 

INTEGER*2  I OPT , IN , 1 Y, 1 M , 1 D, I YE, I COUNT, 1 P AGE ,IH AR D , 

1 ILINF,IFILE,A(15),J0UT 

C 

C THIS  IS  THE  INPUT  ROUTINE  FOR  THE  HAIL  LOG  FILE 

C REVISED  5/30/78  FOR  OUTPUT  OF'  DATA 

C »•  7/14/78  FOR  DELAYED  OUTPUT  AND  NEW  DATA  FIELDS 

C 

CALL  TIMDAT(A,15) 

IF(A(13).EQ.*JU».0R.A(13).E0.*NH».0R.A(13).E0.»RJ».0R. 

1 A(13) .EO. *DK».0R.A( 13) .EG. *GM»)  GOTO  3 

URITE(1,4) 

4 FORMAT!*  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.*,/, 

1*  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT.2621 

1.*) 

RETURN 

3 URITE(1,11) 

11  FORMAT!*  IS  THIS  A CONTINUATION  OF  INPUT  (YES  OR  NO)*) 
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(2A3'l) 

(2435) 

(2436) 

(2437) 

(2430) 

(2439) 

(2440) 

(2441) 

(2442) 

(2443) 

(2444) 

(2445) 

(2446) 

(2447) 

(2448) 

(2449) 

(2450) 

(2451) 

(2452) 

(2453) 

(2454) 

(2455) 

(2456) 

(2457) 

(2450) 

(2459) 

(2460) 

(2461) 

(2462) 

(2463) 

(2464) 

(2465) 

(2466) 

(2467) 

(2460) 

(2469) 

(2470) 

(2471) 
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J0UT=0 

REAO(1»10)IOPT 
1F(I0PT.EQ.*YE»)  GOTO  12 
IF(10PT.NE.»N0»)  GOTO  3 

13  WRlTE(ltl4) 

14  FCRMAT(*  DO  YOU  WISH  TO  START  A NEW  ENTRY  ( NEW  )♦./» 

1*  OP  SPOOL  LAST  OUTPUT  AGAIN  ( LAST  )»t/» 

1»  OR  SPOOL  NEW  DATA  ENTERED  (DATA)*) 

READ(1*10)  lOPT 
IF(IOPT.EO.*NE»)  GOTO  15 
1F( IOPT.E«.*LA*)  GOTO  21 
IFdOPT.Nt.'DA*)  COTO  13 
JOUT=) 

GO  TO  15 

21  CALL  SRCHJ J (KJCLOS , »Rf VS  », 6, 0,0.0) 

CALL  SRCHJ$(KiCLOS, »DATE  *,6,0, 0,0) 

CALL  CNAM1J(*SAVF  *,6,*0UT  *,6,IC) 

CALL  C0KIS1(*SCUT*,4,12,IC) 

CALL  EXIT 

15  CALL  SRCHtJ (KJ DELE, ’SAVE  *,6,0, 0,0) 

UftI TE ( 1,3030 ) 

3030  FORMATdX, ’STAND  BY.  SYSTFH  NOW  PERFORMING  FILE  HOUSEKEEPING’/) 
REWIND  lU 
COUNTRrO 

WRITE(10,16)COUNTR 

16  F0RHAT(8X,I3) 

REWIND  10  • . 

C OPEN  TEMPORARY  FILE  FOR  VOUGHT  CORRESPONDENCE 

12  CALL  SRCh$$(KlRDWR*KSNDAM,’VC  ’,3,14,1,10 

C OPEN  TEMPORARY  FILE  FOR  OUTGOING  HAIL 

CALL  SRCH$$ (K$ROWR*K$NDAH,»OH  ’,3,13,1,10 
C OPEN  temporary  FILE  FOR  INCOMING  HAIL 

CALL  SRCHSKKIRDWR’KSNDAH.’IH  ’,3,12,1,10 
C ' 

C OPEN  ALL  SUE  FILES  FOR  INPUT  MODE 

C 

IF(JOUT.EO.l)  GOTO  1001 
CALL  OPEN  • 
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<247j»  CALL  SRCH$J(KtROUR*KSNDAM»*ACTD  •*6.5»1»IC) 

(2473)  C SET  TRANSMITTAL/SPECIFICATION  SUB-FILE  FLAG 

(2474)  ITRSP=1 

(2475)  C 

(2476)  C PLACE  HAIL  LOG  SUB  FILES  AND  TEMPORARY  STORAGE  FILES 

(2477)  C AT  THE  END  OF  FILE  MARKER 

(2478)  C 

(247S)  REWIND  10 

(24P0)  READ(10,16)  COUNTR 

(2481)  RFUIND  10 

(2482)  1000  READ(G«END=2000)MS*ATHR,DD*TO.DLN*SUB.PTIT, 

(2463)  1 ROUT»inD»COUNT,CUA,CONT,ADDfTUXtFSCtNREfDDT 

(2484)  GO  TO  1000 

(2485)  2000  DO  2010  IN=11,15 

(2486)  2011  READ(1N,END  = 2010)  MS* ATHR , DD « TO ♦ DLN»SUD iPT I T » ROUT , I DO t COUNT , 

ro  (2487)  1 CUA»CONT»ADD*TUX»FSC»NRE 

. L (2488)  GO  TO  2011 

(2489)  2010  CONTINUE 

(2490)  2020  DO  2005  IN  = 16,1R 

(2491)  2001  READ(IN,END=2005)HS»ATHR«DD»TO,DLN»SUB»PTIT*ROUT» 

(2492)  1 IDD*COUNT,CWAtCONT,ADD»TWX»FSC»NRE«DDT 

(2493)  GO  TO  2001 

(2494)  2005  CONTINUE 

(2495)  2006  RE AD (9 »END=2 0 60 ) ATHR , DLN «PT I T , I DD«COUNT » ADO «FSC »NRE 

(2496)  GO  TO  2006 

(2497)  C 

(2498)  C DISPLAY  INSTRUCTIONS  ON  USER  TERMINAL  SCREEN 

(2499)  C 

(2500)  2060  URITE(1«20) 

(2501)  20  FORMAK*  WELCOME  TO  THE  MAIL  LOG  FILE  INPUT  ROUTINF*,/* 

(2502)  1*  PLEASE  NOTE  THAT  ALL  ENTRIES  ARE  TO  BE  PLACED*. /♦ 

(2503)  1*  BETWEEN  THE  EXCLAMATION  HARKS  AND  SHOULD  BE  LEFT*. IX. 

(2504)  l*JUSTIFIEO*,/> 

(2505)  C 

(2506)  C GET  THE  CURRENT  DATE 

(2507)  C 

(2508)  1001  WRITE(1.30) 

(2509)  30  FORMAT!*  FIRST  - PLEASE  ENTER  THE  CURRENT  INPUT  DATE*./. 
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(2510) 
<2511) 
(2512) 
(2515) 
(251'l) 
(2515) 
(251G) 
(2517) 
(2518) 
(2519) 
(2520) 
(2521) 
(2522) 
(2523) 
(252A) 
(2525) 
(2526) 
(2527) 
(2528) 
(2529) 
(2530) 
(2531) 
(2532) 
(2533) 
(253A) 
(2535) 
(2536) 
(2537) 
(2538) 
(2539) 
(TB^tO) 
(2541 ) 
(2542) 
(2543) 
(2544  ) 
(2545) 
(2546) 
(2547) 


1*!HHDDVY*»/) 

READ(1,40,ERR=1001)IM,ID, lY 
40  F0RHAT(1X*3I2) 

C 

C PERFORM  VALIDITY  CHECKS  ON  INPT  DATE 

C 

IF(IM.GT.12  .OR.  ID.GT.31)  GOTO  1001 
IFdY.LO.O  .OR.  IM.EQ.O  .OR.  ID.EQ.O)  GOTO  1001 
REWIND  10 

C STORE  VALID  DATE  PY  MONTH*  DAY*  YEAR 

UHITF ( 10, 17)IH,ID*I YtCOUNTR 
17  F0RHAT(1X,312,1X,I3) 

REWIND  10 
C 

C SET  INPUT  OPTION  FLAG 

IF(JOUT.EG.l)  GOTO  99 
1(12  R = 0 . • 

6 PERFORM  INPUT  OF  RECORD  ITEMS 

CALL  INPSC 
COUNTR=COUNTR*l 
CCUNT=COUNTR 

1002  WRlTEd  ,1  003) 

1003  FCRMAT(2X, ’WHICH  SUB-FILE  IS  THIS  RECORD  TO  BE  STORED  (NUMBER)’*/* 

1 6X,’l.  TP.ANSMITTAL/SPECIFICATION  2.  MEMO /LETTER ’,/ * 

1 6X*’3.  TUX/MAGNAFAX/RAPIFAX  4.  ANNOUNCEMENT’,/* 

1 bX,’5.  PURCHASE  REQUEST  6.  MISCELLANEOUS/REPORT ’/) 

READd,  1004,ERR  = 1002  )iriLE 

1004  FORHAT(12) 

C MAKE  CHECK  FOR  VALID  ENTRY  FOR  INPUT  SUB-FILE 

IFdFILE.LE.O.OR.IFILE.GT.G)  GOTO  1002 

C - . 

C STORE  RECORD  IN  THE  APPROPRIATE  SUB-FILE 

C 

IFdFILE.EQ.l  ) WRIl(l  (6 ) MS  , ATHR  ,DD  * TO , OLN  ,SUP  ,P  TI T *ROUT  * IDD  *COUNT  , 

1 CWA ,CONT,ADD*TWX,FSC,NRE*DDT 

IF (IFILE.EG.2)  WR  I T E ( 1 1 ) MS  , A THI , DD , TO  ,DLN , SUB  * PT I T* ROUT, I DD* COUNT  * 
1 CWA,C0NT,ADD,TUX*FSC*NRE 

IFdFILE.EC.3)  WRITE(12)KS, ATHR,DD,T0*DLN,SUB,PTIT,R0UT*IDD*C0UNT* 
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DO  : 
o O 


vn 


2548) 

2550) 

2551) 

2552) 

2553) 
255A) 

2555) 

2556) 

2557) 
2 550) 

2559) 

2560) 

2561) 

2562) 

2563) 
256't) 

2565) 

2566) 

2567) 
2566) 
2569) 

257  0) 

2571) 

2572) 

2573) 
2578) 

2575) 

2576) 

2577) 

2578) 

2579) 

2580) 
2581  ) 
2582) 

258  3) 
2588) 
12585) 


1 CVAfCONT, ADDtTWX.FSCfNRE 

IF(lFILr.EQ.8)  URITE(13)MS,ATHR,DO.TO»DUN»SUB.PT1T,ROUT, IDDtCOUNT. 
1 CUA,CONT»ADD»TWXf FSCfNRC 

IF(1FILE.EQ.5)  WR I T E ( 1 8) nS, ATHR »DD *T 0 «nLN» SUB »PT IT »R0UT »IDD*C0UN T* 
1 CUA»CCNT,ADD,TUX»FSC,NRF. 

IF(IFILE.E0.6)  WRITE(15)  HS»ATHiunD.T0tl)LN.SUB,PTIT»R0UTiIDD»C0UNT, 
1 CUA,C0NT,ADD»TWX, FSCfNRC 

C 

C STORE  RECORD  IN  THE  APPROPRIATE  MAIL  STATUS  TEMPORARY  FILE 

C • 

IFCMS.FQ.’VC*)  URITrn8)MS«ATHR,DD»TO.nLN,EUn«PTIT,ROUT,IDDtCOUNT 
1,CUA,C0NT,AU0»TWX.FSC»NRE,0DT 

If (MS.EQ.*0M*  ) URITE(17)MS,ATIlR,DD«T0»nLN,SUH,PTTT  tROUT»IDD.CnUNT 
IfCUAfCONTfAPOfTUXtrSCfNRrfDDT 

IF (MS.EO. • IM»)  URITE(16)M5,ATHR*DD*T0,DLN*SUB.PTIT .ROUT 1 1 00 t COUNT 
l.CUA.CONT.ADD.TUX.rSC.NRF.BBT 

IF(AOCd).NE.O)  L'R  I T L ( 9 ) A THR  , BLN  , PTIT  « I TO  , COUNT  , ADD.FSC.NRE 
ITEMS. EO. MM*)  GOTO  103 
DO  3000  l=l.h 
DO  3001  J=l,5 

IF(TUX<I,J).NE.*  •)  GOTO  3010 
3001  CONTINUE 
3000  CONTINUE 
GO  TO  103 

3010  WRITE(1.3020) 

3020  F0RMAT(1X,*STAND  E;Y.  SYSTEM  NOW  IN  AUTOMATIC  UPDATE  MODE*/) 

CALL  UPDATE 
103  WRITE(1»70) 

70  FORMATE*  FURTHER  DATA  TO  BE  INPUT  (YES  OR  NO)*,/) 

READ  El, 10 ) ICPT 
IF(IOPT.EO.*YE*)  GOTO  102 
IF EIOPT.NE.*NO* ) GOTO  103 

C • 

C CLOSE  ALL  SUB  FILES  FOR  MAIL  LOG 

C 

CALL  CLOSE 

CALL  ERCHS$EK$CLOS,*ACTD  *,6,0, 0,0) 

REWIND  10 


) 
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URlTE(10,17)IMtID«I YfCOUNTR 

(25R7) 

REWIND  10 

(2568) 

111 

URITE(1»112) 

(2589) 

112 

FORMAK*  DO  YOU  DESIRE  THE  DAILY  OUTPUT  (NOW  OR  WAIT)*) 

(2590) 

READ(ltlO)IOPT 

(2591) 

IF(IOPT.EO.*WA*)  GOTO  113 

(2592) 

IKIOPT.NE.'NO*)  GOTO  111 

(2593) 

C 

INITIALIZE  COMPLETE  OUTPUT  OPTION  FLAG 

(2599) 

99 

IHA((D  = 0 

(2595) 

C 

OPEN  TEMPORARY  OUTPUT  FILE  FOR  HARD  COPY  ON  PRINTFR 

(2596) 

CALL  SRCHXS(KJRDWR+KSNSAH,*OUT  *,6t3»0»0) 

(2597) 

J=:901 

(2598) 

WR1TE(7»10)J 

(2599) 

10 

FORHAT(lA2> 

(2500) 

101 

WRITEdfSO) 

DO 

1 

■ (2601) 

50 

FORHAT(*  WILL  YOU  WANT  A COMPLETE  DATA  PRINTOUT  ALONG  WlTH*»/» 

(2602) 

1 • THt  DAILY  BRIEF  OFFICE  OUTPUT  (YES  OR.NO)»»/) 

ro 

(2603) 

READ(1»10)IOPT 

(2609) 

IFdOPT.EQ.'NO*)  GOTO  135 

c?- 

(2605) 

IFdOPT.NE.'YE')  GOTO  101 

tr' 

(2606) 

C 

SET  COMPLETE  OUTPUT  OPTION  FLAG 

(2607) 

IHARD=!  ‘ 

(2608) 

GG  TO  135 

(2609) 

C 

CLOSE  ALL  TEMPORARY  KAIL  STORAGE  FILES  FOR  DELAYED  INPUT 

(2610) 

113 

CALL  SPCHtX (KXCLOSt * VC  *,3tOfOtO) 

(2611) 

CALL  SRCHtKKSCLOS*  »OM  *,3«0»0*0) 

(2612) 

CALL  SRCH$$(KICLOS» *IH  »«3*0,0t0) 

(2613) 

(2619) 

C 

RETURN 

(2615) 

C 

SET  ALL  TEHORARY  MAIL  FILES  TO  TOP  OF  FILE  FOR 

(2616) 

c 

OUTPUT  FORMATTING  PRIOR  TO  SPOOL 

(2617) 

c 

(2618) 

135 

REWIND  18 

(2619) 

REWIND  17 

(2620) 

REWIND  16 

(2621) 

C 

INITIALIZE  FILE  INDICATOR 

(2622) 

IN  = lb 

(2623) 

C 

INCREMENT  TO  NEXT  TEMPORARY  STORAGE  MAIL  FILE 

B-202 
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(2824) 

137 

(2825) 

(2828) 

C 

(2827) 

(2828) 

C 

(2829) 

(2830) 

145 

(2831) 
( 283?) 

C 

(2833) 

C 

(2834) 

C 

(2635) 

(2638) 

C 

(2637) 

(2838) 

(2839) 

(284tH 

80 

(2841) 

(2842) 

°0 

(2843) 

100 

(2644) 

110 

(2845) 

C 

(2646) 

C 

(2847) 

(2848) 

C 

( 2649) 
(2850) 

120 

(2851) 

C 

(2852) 

C 

(2853) 
(2<>:i4  ) 

C 

(2( 55) 

C 

(2856) 

C 

(2857) 

(2858) 

C 

(2859) 

(2880) 

(2881) 

130 

IM=IN+1 

INITIALIZE  LINE  COUNTER  FOR  NEU  PAGING  CHECKS 
IPAGE=0 

INITIALIZE  FILE  RECORD  COUNTER 
ICOUNT=3 

READ(IN«LND=1090)HS» ATMR,DD*TO,nLN,SUB»PTIT,ROUT«IDO»COUNT, 

1 . CUA,CONT»ADD,TUX,FSC»NRF’iDDT 

IS  THIS  THF  TOP  OF  PRINTER  PAGE 
IF (IPAGE.NE.O)  GOTO  107 

FORMAT  HEADING  FOR  APPROPRIATE  HAIL  STATUS 

WRITE (7,80) 

F0RMAT(n*,AX,115(»**)> 

IF(ir.'.EB.lR)  WRITE(7,90)  IHtlD.IY 
IF(IN.E0.17)  WRITE<7,100)  IM,ID,IY 
IF(IN.EG.IG)  WRITE(7»110)  IH,IO,IY 

F0KHAT(28X,»V0UGHT/DALLAS  CORRESPONDENCE* ,16X, * I NPUT  DATE*»2X, 

1 2( 12, •-*) , 12) 

F0RMAT(3bX, 'OUTCOING  M M L * ,25 X , • I NPUT  DATE  * , 2X, 2 (12, •-• ) , I 2) 
F0RMAT(35X,*INC0HING  H A I L • , 25X , • I NPUT  DATE *,2X ,2 ( 12 , ♦-» ) , 12) 

FORMAT  RECORD  ITEM  ORDER  FOR  BRIEF  LISTING 

URITE(7,120) 

FORMAT(bX,*SUbdECT* ,71X, »DOCUHENT  D ATE • ,3X , ‘FI LE  SYSTEM  CODE*,/, 
15X,* AUTHOR /SOURCE*, 1 8X ,* TO ♦ 3A X ,* ROUTING *, 20X ,* TYPE /LETTER  NUMBER*) 

IS  THIS  A COMPLETE  OUTPUT  LISTING 

IF  ( IHARD.ECI.O  ) GOTO  lOf- 

FORHAT  RECORD  ITEMS  ORDER  FOR  A COMPLETE  LISTING 
WRITE(7,130) 

F0RHAT(5X, *ACTICN  DUE  D ATE ♦ , 1 6 X, *U A NUHBER/ID  CODE*, 

119X,*C0NTRACT  NUMBE R * , / , 5 X, » NA S A RESPONSIBLE  ENGI NEER  ( S ) • , . 

1/,5X, *REFERENCE  DOCUMENT  NUMBER ( S )»,/, 5X, * DESCRIPT  ION  OF  ♦ 


) 


) 
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<xji 


(2662) 

(2663) 

C 

(266A) 

C 

(266b) 

(2666) 

106 

(2667) 

85 

(2668) 

C 

(2669) 

(2670) 

107 

(2671 ) 

. lAO 

(2672) 

(2673) 

C 

(267A) 

C 

(267b) 

C 

(2676) 

C 

(2677) 

C 

(2678) 

(2679) 

150 

(2680) 
( 26E1) 

C 

(26F 2) 

c 

(2683) 
(268  A) 

c 

(268b) 

c 

(2686) 

(2687) 

c 

(2688) 

c 

(2689) 

c 

(2690  ) 

c 

(2691) 

c 

(2692) 

c 

(2693) 

c 

(269A) 

(2695) 

160 

(2696) 

(2697) 

(2698) 

(2699) 

It ‘TRANSKITTAL  OR  SPECIFICATION*) 

INCREMENT  LINE  COUNTER  FOR  EXTRA  OUTPUT  LINES  DUE  TO 
COMPLETE  LISTING  HEADING 
IPAGE=IPAGF+4 
URITE{7t65) 

FORMAT (5X 1 1 15(  •*•)  ) 

INCREMENT  LINE  COUNTER  FOR  NORMAL  BRIEF  OUTPUT  LISTING 
IPAGE=IPAGE*5 
URITE(7.1A0) 

FORMAKlHOt/) 

IPAGE=IPAGE*2 

PRINT  RECORD  NUMBERt  SUB JECTt D ATE t FI L E CODEtAUTHORt 
WHO  lOtROUTINGt  AND  DOCUMENT /LFTTFR  NUHDFR  OF 
OUTPUT  rUF  FOR  SPOOL 

URITr(7tlCO)ICOUNTtPTITtODtFSCtATHRtTOtROUTiDLN 
F0((MAT(lX,I2t».*,lX,19AAt5Xt2(12f*-*),I?,5Xf?AAtA2t*/»t2AAt 
1 A2t/ tBX* 7AA t 3Xt8AA t3Xf 5 ( A3t •/ * ) t A? t5Xt A AA t A2) 

INCREMFNT  LINE  COUNTFR  FOR  THF  TUO(2)  LINE  BRIEF 
LISTING  OUTPUT  OF  RECORD  ITEMS 
IPAGE=IPA6E*2 

IS  THIS  A COMPLETE  OUTPUT  LISTING 
IFdHARD.E&.O)  GOTO  1070 

PRINT  ACTION  DUE  DATE.UA  NUHBER/ID  CODEtCONTRACT  NUMBER 
PRINT  RESPONSIBLE  NASA  ENGINEERtS) 

PRINT  REFERENCED  DOCUMENT  NUMEER(S) 

PRINT  DISCRIPTION  OF  TRANSMITTALS  OR  SPECIFICATIONS 
INCRCMENT  FOR  APPROPF.lATE  NUMBER  OF  HULTIPLF  ENTRIES 

URITE  (7tl60)  ADD»CWAiCOr;T 

FORMAT CbXt2( 12 t *-•) t I2t23XtAA2t2nXt BAA) 

IPAGE-IPAGE+1 
ILINE=P 
KRE  = 0 

DO  1301  L=l,3 
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(2700) 

ir(NRE(l»L)  .NB.*  »)  KRt=KRE:+l 

{2701) 

1501 

CONTINUE 

(2702) 

IF(KRE.EO.O)  GOTO  1050 

(2703) 

WKITE(7tl70)  (NRE(l«L)»L=lt3) 

(270<i  ) 

170 

F0RMAT(5Xf3(A3,lX)  ) 

(2705) 

ILINE=ILINE*1 

(2706) 

IPAGE=IPAGE+1 

(2707) 

1050 

IF(ILINE.NE.O)  GOTO  1065 

(270R) 

URITE(7,175) 

(2709) 

175 

FORMAT (5X , ’NONE*) 

(2710) 

IPAGE  = IPAGE-*1 

(2711) 

1065 

ILINE-0 

(2712) 

DO  1200  M=l.b 

(2713) 

KIU  = 0 

( 2 71  't ) 

DO  1202  N=1 ,5 

(2715) 

1F(TUX (M tN ) .NE.»  •)  KTW=KTW*1 

(2716) 

1202 

CONTINUE 

(2717) 

IF(KTU.EQ.O)  GOTO  1250 

(271S) 

WRITF(7tl205)  ( TWX ( H , N) , N=l«5 ) 

(2719) 

12  05 

F0PMAT(5X,4A4, A2) 

(2720) 

ILINE  = ILINr.+  l 

(2721) 

IPAGE=IPAGE+1 

(2722) 

1200 

CONTINUE 

(2723) 

1250 

IF  ( ILINE.NE.O)  GOTO  1299 

(2724) 

URITF(7,1210) 

(2725) 

1210 

FORMAT(5X.»NONE») 

(2726) 

IPAGE=IPAGE+1 

(2727) 

1299 

CONTINUE 

(2728) 

1060 

00  1400  I=l»30 

(2729) 

KOD  = 0 

(2730) 

DO  1401  J=l»21 

(2731) 

IF  (nOT( I« J> .NE. • »)  KDO=KDD  + l 

(2732) 

1401 

CONTINUE 

(2733) 

IMKDD.EQ.O)  GOTO  1070 

(273't) 

WRITF(7»100)  (DDT(I.J)»J=1»21) 

(2735) 

180 

FORMAT (4X,7(lX.2A4rA2)) 

(2736) 

IPAGE=1PAGC*1 

(2737) 

1400 

CONTINUE 

V 
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(27381 

1070 

(273'^) 

(2740> 

C 

(2741 . 
(2742> 

C 

(2V43) 

c 

(2744) 

(2745) 

(27465 

c 

(2747) 

c 

(2748) 

(27495 

(2750) 

loao 

(2751) 

c 

(275?) 

1090 

(275^) 

1100 

(2754) 

(2755) 

C 

(2756) 

(2757) 

(2758) 

C 

(2759) 

c 

(2760) 

c 

(2761) 

1110 

(2702) 

(2763» 

(2764) 

(27oE) 

(2766) 

(27675 

c 

(2768) 

(2769) 

(2770 

(2771) 

c 

(2772) 

c 

JP775) 

f277-vi 

c 

( 5 7 V5) 

1120 

CONTINUE 

INCREMENT  FILE  RECORD  COUNTER 
IC0UNT=IC0UNT41 

IS  THIS  A FtRIEF  OUTPUT  LISTING 
IF(IHAkD.NE.O)  GOTO  lOFO 

IS  THIS  THE  UOTTOH  OF  THF  PRINTER  PAGE 
YES,  SET  TOP  OF  PRINTER  PAGE  FLAG 
IFdPAGE.GE.47)  IPAGE  = 0 
GO  TO  145 

IS  THIS  THE  BOTTOM  OF  THE  PRINTER  PAGE 
YES,  SET  TOP  OF  PRINTER  PAGE  FLAG 
IFdPAGE.GE.40)  IPAGE=0 
GO  TO  145 

DOES  THIS  COMPLETE  ALL  TEMPORARY  STORAGE  HAIL  FILES 
IF(IN.NE.IB)  GOTO  137 
CONTINUE 

WAS  THIS  A COMPLETE  OUTPUT  LISTING 
IFdHARO.EQ.O  ) GOTO  1110 
, SET  TO  A BRIEF  OUTPUT  LISTING  REQUEST 
IHAKD=n 
GO  TO  135 

CLOSE  ALL  OPEN  FILES 
CALL  SRCHJK KSCLOS, »OUT  *,^,0,0,0) 

CALL  SRCHSKKSCLOS, ‘DATE  *,6,0,0, 0) 

CALL  SKCHIKKJCLOS, 'REVS  *,.6',0,0,0) 

CALL  SRCHll (KICLOS, *VC  *,3,0, 0,0) 

CALL  SRCHI.$(KICLOS,»OM  *,3,0, 0,0) 

CALL  SRCHlJf  KICLOS.,  *IH  *,3,0, 0,0) 

DELETE  THE  TEMPORARY  STORAGE  HAIL  FILES 

CALL  SRCH$i(KJDELE,*VC  *,6,0, 0,0) 

CALL  SRCHIt(KIDELE,*IM  *,6,0, 0,0) 

CALL  SRCHIUKiLELf  ,*OM  *,6,0, 0,0) 

SPOOL  THE  TEMPORARY  OUTPUT  EILE  TO  THE  PRINTER 
CALL  COf1IiJ(*OUTS*,4,l?,IC) 

CALL  EXIT 
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(ooon  c 

(0002>  C OIR-REPORT  FILE  FOR  NASA/SPO 

(0013»  C 

(Ol'OA)  C WRITTEN  BY  DANNY  K.  KARRIS  - VOUGHT  CORP. 

(COObJ  C FOR  THE  NAS A/SPO/PR IRE  300  MINI.  COMPUTER 

(0006?  C 
(0007)  C 
(DOOR)  C 

tOOOB)  C COMMON  BLOCK  FOR  THE  OIR  FILE 

(OOOfl)  C 

<0008)  COMMON  TIT, PTIT, DIR, RPT ,DT, SYS, WAN, CON, ID*VEH»ACT»R 

(0008)  COMMON  COMP , RE V ,R D A T , U A 

(0008)  C 
(00C8)  C 

O (0008)  C DATA  DECLARATION  BLOCK  FOR  THE  OIR  FILE 

(0008)  C . 

<000b'  INTEGER*4  T I T ( 2 1 ) , PT I T ( 19 ) , D I R ( A ) , RPT ( A) , S YS ( 3) , CON ( 5) , ID  , ACT 

(0068)  INTEGERH  C0MP(21) 

<C<I08)  INTEGER»2  D T ( 3 ) ,W  AN  ( A ) , VEH  ( 2 , 2 ) , R , RE  V , RD  AT  ( 3 ) , W A ( A ) 

(0008)  C 

(0005)  C S YSCOH>KEYS  .F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY,  I*??? 

(0009)  NOLIST 

(0010)  INTEGER*2  I C , I PAS  ( 3 ) , I T 

(0011)  CALL  CLEAR 

. (0012)  C 

(0013)  C FILES  USED  ' 

(OOIA)  C FILE  UNIT  FUNIT  DESCRIPTION 

(0015)  C 

(0016>  C TTY  1 1 TERMINAL 

(OOin  C DIR  6 2 DIR  DATA  STORAGE  FILE 

(0018J  C OUT  7 3 . OUTPUT  FILE  FOR  THE  SPOOLER 

(0019)  C REVS  8 A TEMP  FILE  FOR  USE  IN  THE  REVISE  RUN 

(0020)  C INACT  9 5 INACTIVE  DOCUMENT  STORAGE  FILE  - ARCHIVE  RUN 

(0021)  C TEMP  10  8 GENERIAL  PURPOSE  TEMP  FILE 

(0CL2)  C 

(0C23)  C 

(0C2A)  CALL  C0MI1S(»TTY  *,6,12,10 

(0025)  CALL  IDENT 


(0026) 
(ocay; 
(0''28> 
(0029) 
( CG30) 
(0031  ) 
(0032) 
(0033) 
(003'0 
(0035) 
(0036) 
(003V) 


(C036) 

(0039) 

(OC'iO) 

(00^1) 

(0042) 

(0043) 

(00*4) 

(0045) 

(0046) 

(0047) 

(0048) 

(00)9) 

(0050) 

(0051) 

(0052) 

(0053) 

(0054) 

(0055) 

(0056) 

(0057) 

(0058) 


(0059) 
( 0060 
(0061) 
(0062) 
(0063) 


2 

4 


1000 

1002 

1001 


1 * 
!• 
1 • 


CALL  BREAK$(.TRUE.) 

CALL  SRCH$$(K$RDWR+K$NDAH,»DIR  •»6»2»IT»IC) 
IFdC.NE.O)  GOTO  1000 

CALL  SRCHJS (K$RCUR  + K$NOAM» *REVS  *t 6 ♦ 4 ♦ I T, I C ) 
CALL  SRCHlJ(KIRCVR  + KlNOAH,»TrMP  » , 6 »6  , IT , I C ) 
URITE(1«3) 

CALL  BREAKJ(.FAISF.) 

READ(1,4)IDES 
REUIND  8 
REWIR'D  10 
F0RrAT(/,2) 

IF( IDES. EQ . ‘IN' ) CALL  INPTDR 
IF(IDES.EG.«SE»)  CALL  SEADR 
IFdDES.EG. ‘REM  CALL  hEVSDR 
IFdDES.EQ.  *AR‘ > CALL  ARCDR 
IF(IDES.EO.*GU»)  CO  TO  1001 
CALL  CLEAR 
URITE(1,3) 

F0RMAT(*  PLEASE  CHCSE  ONE  OF  THE  FOLLO WI NG * » / t 

KEY»,/, 

INP*,/, 

REV»,/, 

SEA*,/, 

ARC*,/, 

QUIT*,//) 


MODE 
INPUT 
REVISE 
1*  SEARCH 
1*  ARCHIVE' 

1*  QUIT 
GO  TO  2 
URITF(1,1002> 

FCRMAT(*DIR  FILE  IS  IN  USE  - PLEASE  TRY  LATER*/////) 
IPAS(1)=*  * 

IPAS(2)=*  * 

IPAS(3)=*  * 


CALL  SRCH$J(KJCLOS,*DIR  *,6,0, 0,0) 

CALL  SRCHS$(K$CLOS,*REVS  *,6,0, 0,0) 

CALL  SRCH$I(K$CLOS,*TEMP  *,6,0, 0,0) 

CALL  ATCH$$(«f_maIL*,6,K$ALLD,IPAS,K$IHFD+K$SETH,IC) 
CALL  RESUII ( *BF  ILE*  ,5) 

CALL  EXIT 
END 


L. 
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AC1 

J 

//  000175 

DOORS 

ARCOR 

R 

EXTERNAL  000000 

OOAO 

AtCHiS 

R 

EXTERNAL  OOOOOC 

00  DC 

BREAKS 

R 

EXTERNAL  000000 

0026 

0032 

CLEAR 

R 

EXTERNAL  OOOOOO 

0011 

00A2 

COHISS 

R 

EXTERNAL  OOOOOO 

C02A 

COilP 

J 

//  000200  . 

0006S 

cri\i 

J 

//  000155 

OCORS 

DIR 

vi 

//  CC0120 

0008S 

DT 

I 

//  OOOl'iO 

COOPS 

EXIT 

R 

EXTERNAL  OOOOOO 

006? 

IC 

I 

0CCA25 

OOlOS 

002A  A 

0027A 

0028  . 

0029A 

0030A  0060A 

lU 

J 

//  ■ 000167 

COOPS 

IDEHT 

I 

EXTERNAL  OOOOOC 

0C25 

IDES 

I 

OOOA26 

C033H 

0037 

0038 

0039 

0 04  0 

0041 

INPTOR- 

I 

EXTERNAL  000000 

0037 

IPAS 

1 

000002 

DOIOS 

0054M 

0055H 

0056M 

0060A 

IT 

i 

0CC'(27 

OOlCS 

0027A 

0029A 

0030A 

KSALLO 

I 

PARAMETER 

0006S 

0060 

KSCACC 

I 

PARAMETER 

0 0 0 ‘ < S 

KSCLOS 

I 

PARAMETER 

DOOMS 

0057 

0058 

0059 

KSCPNV 

I 

PARAMETER 

DOOMS 

KSC'JRR 

I 

PARAMETER 

DOOMS 

KSOELE 

I 

PARAMETER 

ODOR’S 

KSOHPB 

I 

PARAMETER 

DOOMS 

KSDTIH 

I 

PARAMETER  ' 

GOODS 

KIENTR 

I 

OOOOOO 

00C9S 

K-EXST 

I 

PARAMETER 

DOOMS 

KSGOND 

I 

PARAMETER 

0D09S 

KSGPOS 

I 

PARAMETER 

DOOMS 

< 

KSHOME 

I 

PARAMETER 

C009S 

KSICUK 

I 

PARAMETER 

DOOMS 

KSIIIFD 

I 

PARAMETER 

DOOMS 

0060 

KS  IRTN 

I 

PARAMETER 

OCOMS 

■ 

K'SIBEG 

I 

PARAMETER 

DOOMS 

KSIUFD 

I 

PARAMETER 

DOOMS 

KSMENT 

I 

OOOOOO 

OCOMS 

KSMSIZ 

I 

PARAMETER 

DOOMS 

* 

c 
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K-iMVNT 

I 

parameter 

0009S 

KSIJDAM 

I 

PARAMETER 

0009S 

KlMfiTN 

I 

PARAMETER 

00  09S 

KIWGAH 

I 

PARAMETER 

0 0 0 9 S 

KIIMbGO 

I 

PARAMETER 

0009S 

IllMSGS 

I 

PARAMETER 

00096 

KIPOSA 

I 

PARAMETER 

0009S 

K$POSN 

I 

PARAMETER 

0009S 

KSPOSR 

I 

PARAMETER 

0009S 

KIPP.EA 

I 

PARAMETER 

0C09S 

KJPRER 

I 

PARAMETER 

0C09S 

KSPROT 

I 

PARAMETER 

00C9S 

KSRDUR 

I 

PARAMETER 

0G09S 

KSREAD 

I 

PARAMETER 

0 0 0 9 S 

K$KPOS 

I 

PARAMETER 

00  09S 

K5.RSUB 

I 

PARAMETER 

C009S 

K$PWLK 

I 

PARAMETER 

00  09S 

;<SSENT 

I 

000000 

0 0 0 9 S 

KSSETC 

1 

PARAMETER 

0009S 

KSSt TH 

I 

PARAMETER 

0009S 

KVSPOS 

I 

PARAMETER 

0009S 

KSSRTN 

I 

PARAMETER 

0005S 

KSTRNC 

I 

PARAMETER 

00  09S 

KSUPOS 

I 

PARAMETER 

OOQ'-S 

KIWHIT 

I 

PARAMETER 

00  095 

PTIT 

J 

n 000052 

COCOS 

R ■ 

I 

//  000177 

no  DBS 

SDAT 

I 

//  000253 

00  01' ;; 

RESUSS 

R 

EXTERNAL  OOOCCO 

CO  61 

REV 

I 

//  000252 

00C6S 

RLVSOR 

R 

EXTERNAL  000000 

0039 

RFT 

J 

//  000130 

OOOCS 

SEAOR 

R 

EXTERNAL  000000 

0038 

SRCHSS 

R 

EXTERNAL  000000 

0027 

SYS 

J 

//  0001A3 

00  08S 

TIT 

J 

//  000000 

OOOBS 

v;h 

I 

//  000171 

OOOGS 

'iA 

I 

//  000256 

oooas 

0027 


0027 


0060 


• 0029 


0029  0030 


0029  0030 


0030  0057  0058 


0059 


c 
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WAN  I n 

000151 

0008S 

_1000 

000317 

0028 

00520 

_1001 

000353 

OOAl 

005AD 

_1U02 

000323 

0052 

0053D 

_2 

OOOOG2 

0033D 

0051 

T > 

OOOlAl 

0031 

00A3 

000077 

0033 

0036D 

00A4D 


0000  ERRORS  C<.MAIN.>FTM-REV1A.23 
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I 

DO 


(00ti47 
(0065)  C 
(0066)  C 
(0067)  C 
(0068)  C 
(0060) 
(0070)  C S 
(0070) 

0071 ) 
(0077) 

( 0 07,’.)  C 
(OOl'i)  C 
(0075)  C 
(0076) 
(0077)  C 
(0078)  C 
(0079)  C 
(0080) 
(0081)  C 
(0087)  C 
(0083)  C 
0089) 
(C065) 
(0036) 

(0087) 

(0088) 

(0089) 
(DOSQ)  25 
(0091) 

(0092)  1 

(0093)  2 

(0099)  C 
(00''5)  C 
(009b)  C 
(0097) 

(0098) 

(009°) 

(0100)  50 


SUBROUTINE  IDENT 

THIS  ROUTINE  KEEPS  TRACK  OF  WHO  ACCESSED  THE  CALLING 
PROGRAM  LAST 

INTEGER*2  ARRAY(15) 

YSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAYt  1977 

NOLIST 

CALL  BREAKS!. TRUE.) 

CALL  TIMDAT(ARRAY»15) 

OPEN  TEMP  FILE  (FUNIT  16) 

CALL  SRCHSS  (KSNMAt’  + KSRCWR,  »TUSER*  ,5, 16,1,  ID 
OPEN  USER  FILE  (FUNIT  15) 

CALL  SRCHSS (KSNDAM+KSRDWR , ’USER*, A, 15,1,10 

NOW  WRITE  USERS  LOGIN  ID,  DATE  (HMDDY),  TIME,  AND  USER  NUMBER 

AMIN=ARRAY(9) 

AH=AHIN/60.0 

IHrAH 

IMH=IH*60 

IMIN=AMIN 

IDM=IHIN-IHK 

URITE(20,1)(ARRAY(I),I=13,15),IH,IDH,ARRAY(5), 

1 (ARRAY! I) , 1=1 ,3) ,ARRA Y(12) 

F0RMAT(3A2,2  ( 13,  * : • ) , 13,1  X,P(  A?.,  »/*  ) , A2,I3)  . 

F0RHAT(3A2,2(I3,1X) ,I3,1X,2(A2,1X),A2,I3> 

NOW  COPY  THE  CONTENTS  OF  USER  TO  TUSER 

READ(19,2,END=50) (ARRAY! I),I=13,15) ,IH,IDH,ARRAY(5), 

1 (ARRAY(I),I=1,3),ARRAY(12) 

GO  TO  25 

CALL  SRCH$$(K1CLOS,*USER*,9,0,0,0)  • 


L 


1 


SUBROUTINE  IDENT 


nioi) 

CALL 

SRCHl$(K$CLOSi •TUSER*,5»0t0,0) 

(010?) 

caLl 

SRCHJ$(K$DELE»*USER'»A,0t0.0) 

( 0 1 0 .T ) 

CALL 

CNARJ$( ‘TUSEP* ,5/*USER».A, IC) 

(01C4) 

CALL 

BREAKl ( .FALSE. ) 

(0105) 

RETURN 

(0106) 

ENO 

o 
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AH 

R 

0003A7 

00R5M 

0 08  6 

AMIR' 

R 

000351 

008AM 

0085 

0088 

ARRAY 

I 

OOOOC2 

0069S 

0072A 

OOPA 

0090  0097M 

BREAKS 

R 

EXTERNAL  000000 

0071 

OlOA 

C^JAHSS 

R 

EXTERNAL- 000000 

0103 

I 

I 

000353 

C090M 

C097M 

IC 

I 

00035A 

0076A 

0080A 

0103A 

IDENT 

I 

000000 

006AE. 

IDK 

I 

000355 

0089M 

0090 

0097M 

IH 

I 

000356 

coesM 

0087 

0090 

0097H 

IKIN  ‘ 

I 

000357 

C0R8M 

0089 

IKH 

I 

000360 

C0P7N 

0089 

KSALLD 

I 

PARAMETER 

CO  70S 

KSCACC 

I 

PARAMETER 

0C70.S 

KICLOS 

I 

PARAMETER 

0070S 

0100 

0101 

KICONV 

I 

PARAMETER 

C07CS 

KtCURR 

I 

PARAMETER 

0C7CS 

ksdeLE 

I 

PARAMETER 

C070S 

0102 

KS DMPB 

T 

PARAMETER 

C07CS 

KTCTIM 

I 

PARAMETER 

0C70S 

KIENTR 

I 

000000 

007CS 

KSEXST 

I 

PARAMETER 

0070S 

KSGCND 

I 

PARAMETER 

CC7CS 

KSGPOS 

I 

PARAMETER 

C070S 

* 

K5HCME 

I 

PARAMETER 

C0  70  S 

K$ ICUR 

I 

PARAMETER 

C07GS 

KllMFD 

I 

PARAMETER' 

CC70S 

K5IRTN 

I 

PARAMETER 

007PS 

K1 ISEG 

T 

PARAMETER 

0070S 

KSIJFD 

I 

PARAMETER 

C070S 

KIMF-n 

I 

000000 

00  70  S 

KSHS’Z 

I 

PARAMETER 

C0  70S 

KSMVNT 

I 

PARAMETER 

G0  70  S 

KSR'D'.M 

I 

PARAMETER 

CO  70S 

0076 

0080 

KSkRTN 

I 

PARAMETER 

00  70S 

Kf.NSAM 

I 

PARAMETER 

0070S 

KSNRGO 

I 

PARAMETER 

00  70  S 

KJNSGS 

I 

o ARAMETER 

C07CS. 

• •» 


SUBROUTINE  IDENT 


KtPOSA  I parameter 

KspoSN  I Parameter 
KtFOSR  I parameter 

KS^'REA  I PARAMETER 

K$?RER  I Parameter 

KiPPOT  I PARAMETER 
KSftOUR  I PARAMETER 
KIREAD  I PARAMETER 
MRFOS  I PARAMETER 
KJ.RSUB  I PARAMETER 
KtRVLK  I PARAMETER 
KS3ENT  I 000000 

KSSETC  I PARAMETER 
KSSETH  I PARAMETER 
KSSPOS  I PARAMETER 
MSSRTN  I PARAMETER 
KSTRNC  I PARAMETER 

KsuPOS  I parameter 
KSU.RIT  I PARAMETER 
?rch$$  r external  COOOOO 
TIMDAT  R EXTERNAL  000000 


C070S 

CC70S 

CC7CS 

007CS 

C07CS 

C07CS 

C07CS  0076 

C07CS 

CC70S 

C07CS 

CC70S 

0070  S 

C07CS 

C07CS 

007CS 

0070S 

C07CS 

00  7QS 

C07CE 

0076  0080 

0072 


_1  000157  0060  0092D 

~_Z  000203  0093D  0097 

25  • 000077  0090D  0099 

50  00030A  0097  OlOOD 


0000  ERRORS  C<IOENT  >FTN-RE Vl 4 . 2 3 
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0080 


0100  0101  0102 


I 


SUBROUTINE  IDUSER(IAI) 


/ SUBROUTINE  IDUSER(IAI) 

/ INTEGER‘2  I F ASS ( A ) 1 1 A ( 1 5 ) 

C 

C THIS  ROUTINE  CHECKS  TO  MAKE  SURE  THAT  THE 

C INCOHMING  USER  IS  VALID 

C 

CALL  BREAK$(  .TRUE  . ) 

CALL  TIMDAT(IA,15) 

CALL  CLEAR 

102  IF (I A( 13) .NE. ’SY* ) GO  TO  101 
IF(IA(1A).NE.»ST’)  GO  TO  101 
IF(IAdb)  .NE.'EH')  GO  TO  101 
GO  TO  103 

101  CALL  COHI S$ ( *L0USER» ,6»12, IC) 

CALL  EXIT 

103  CALL  BREAKS!. FALSE.) 

IAI=IA(13) 

RETURN 

END 


) ) 


(010/) 
(0108) 
(0109) 
(0110) 
(0111 ) 
(0112) 
(0113) 
( 0 1 4 ) 
(0115) 
(0116) 
(0117) 

(one: 

(0119) 
(0120) 
(0121) 
O (0122) 
. (0123) 
(0124) 
C?'  (0125) 
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V 
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breaks 

R 

external 

000000 

01  13 

0122 

CLEAR 

R 

external 

000000 

0115 

CONISS 

R 

external 

OOOOOO 

0120 

EXIT 

R 

EXTERNAL 

OOOOOO 

0121 

lA 

I 

000005 

01C8S 

OllAA 

0116 

0117  0118 

0123 

lAI 

I 

ARGUMENT 

000003 

0107S 

0123M 

IC 

I 

000073 

C120A 

ID'JSER 

I 

OOOOOO 

C107S 

IPASS 

I 

00002* 

cicrs 

TiHPAT. 

R 

EXTERNAL 

OOOOOO 

01  lA 

_101 

000057 

0116 

0117 

0118 

0120D 

_102 

000037 

01160 

~10  o 

000066 

0119 

0122D 
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< 0 1 2 S ) 
(OIL?) 

< C12'i ) 
(0127) 
(0127.’ 
(0127) 
(0127) 
(Cl27) 
(0127' 
(0127) 
(0127) 
v0127) 
(0127) 
(0127) 
(0128) 
(0128) 
(0129) 
(0130) 
(0131) 
(0132; 
(0133) 
( 0 3 5A.’ 
( 03.35) 
(0136) 
(0137) 
(0138) 
(013?) 
(OlAO) 
(01*1) 
(01*2) 
(01*3) 
(01*1) 
(01-5) 
(01*6) 
(01*71 
(01*8; 
(01*9) 
(0150) 


SUBROUTINE  INPTDR 
C 

C COMMON  BLOCK  FOR  THF  DIR  FILE 

C 

COMMON  TIT.PTIT,DIKiRPT,DT«SYS»WAN.CON»ID»VEH«ACT»R 
COMMON  COMP, REV, RDAT.UA 


C 

C 

C DATA  DECLARATION  ELOCK  FOR  THF  DIR  FILE 

C 

INTEGER**  TIT(21),PTIT(19),DIP(*),RPT ( * ) ,S YS ( 3 ) , CON ( 5 ) , ID, ACT 
INTEGER**  COMP(21) 

INTEGER *2  DT(3),UAN(*),VEH(2,2),R,REV,RDAT(3),WA(*) 


C 

C SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER*2  A ( 1 5 ) , I OP T , I T , I C 
INTEGER**  DIRR(*) 

C 

C INPUT  SUBROUTINE  FOR  THE  DIR-REPORT  FILE 

C 

CALL  CLEAR 
C 

C VALIDATE  THE  INCOMMING  USER 

C 

CALL  BREAKS!. TRUE.) 

CALL  TIMDAT(A,15) 

IF( A(13)..EQ.»JU*.OR. A(13) .EQ.»NH*.OR.A(13) .EG.*RJ*.OR. 

1 A(13) .EG.*DK« ) GOTO  3 

WRITEd,*) 

* FORMAT!*  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.*,/, 

1*  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT. 2621 
l.M 
RETURN 

3 CONTINUE 

200  CALL  BREAKS! .FALSE. ) 

URITE(1,1) 

1 FORMAT!*  WELCOME  TO  THE  DIR-REPORT  FILE  INPUT  ROUTINE*,/ 


SUBROUTINE  INPTDR 
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U 


(015?,)  1*  PLEASE  INPUT  INFORMATION  BETWEEN  EXCLAMATION  MARKS**/ 

(0152)  2*  AND  LEFT  JUSTIFY  ALL  ENTRIES*,/) 

(0153)  500  URITE(1,505) 

(015A)  505  FORHAtdHO,/,*  ENTER  THE  DIR  OR  REPORT  NUMBER  *,/,*!*»  1 A X,  *!*/ ) 

(0155)  REAO(1,510,ERR=500)  DIRR 

(0156)  520  REAO(6»END=1010)  T I T , PT I T , 01 R , OT ,S YS , W AN , VEH , REV , RD AT 

(0157)  510  F0RMAT< 1X,3AA, A2) 

(0158)  DO  530  1=1, A 

(015B:-  IF(DIR  ( I)  .NF.DIRR  ( I ) ) GOTO  580 

(0160)  530  CONTINUE 

(016i:  URITF(1,5A0) 

(0162)  5A0  FORMAK*  THIS  DIR/REPORT  IS  ALREADY  IN  THE  DATA  FILE*/) 

(0163)  CALL  SHOUDR 

(016A)  5A5  URITE(1,550) 

(0165)  550  FORMAK IHO,/, * DO  YOU  WISH  TO  REVISE  (YES  OR  NO)*/) 

(0166)  READ(1,560,ERR=5A5)  lOPT 

(0167)  560  F0RHAT(1A2) 

‘i’  (0168)  IFdOPT.EQ.  *t.'0*)  GOTO  1005 

— * (0169)  IFdCPT.ME.’YE*)  GOTO  5A5 

(0170)  . R=1 

(C171)  CALL  INPSDR 

(0172'  UPITEdO)  T1T,PT1T,DIR,DT,SYS,UAN,VFH,REV,RDAT 

(0173)  570  READ(6,END=600)  T I T , PT IT , D IP , D T , S YS , WAN , VEH ♦ RE V, RD AT 

(017'.)  WRITEdO)  TIT,PTIT,DIR,DT,SYS,WAN,VEH,REV,RDAT 

(0175)  GO  TO  570 

(0176)  580  WRITEdO)  T I T , P TI  T , DI R , DT  , S YS  , W AN  , VEH  , REV , RD  AT 

(0177)  GO  TO  .520 

(0178)  600  CALL  SR CHSS ( K SCLOS , *TE HP  *,6,0, 0,0) 

(0179)  CALL  SRCHSSCKSCLOS, »DIR  *,6,0, 0,0) 

(0150)  CALL  SRCH$$(KSDELE, *DIR  *,6,0, 0,0) 

(0181)  CALL  CNAHJ1(*TEM?  *,6,*DIR  *,6,IC> 

(0182)  CALL  SRCH$S(KSRDWR  + KlNr'AH,*DIR  *,6,2,IT,IC) 

(0183)  CALL  SRCHtl (KSRDWR+KtNDAM, *TEMP  *,6,6,IT,IC) 

(0:.PA)  GO  TO  900 

(0185)  1010  R=0 

(0186)  DO  800  J=1,A 

(0187)  DIR(J)=DIRR(J) 

(C188)  800  CONTINUE 
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(0189) 

CALL  INPSDR 

(0190) 

WRITE(6)TIT,PTIT,DIRR,DT,SYS»UANtVEH«REV,RDAT 

(0191) 

1005 

CALL  SRCHSK  KICLOSt  »TEr'.P  *,6*0.0t0) 

(0192) 

CALL  SRCHSS  (KiDELEt ‘TEl'P  ’^e^OtOtO) 

(0193) 

CALL  SRCH$$ (K1RDWR+KSN0AH»*TEMP  •♦6»6»IT,IC) 

(0199) 

900 

WRITE(1»1001) 

(0195) 

1001 

FORHATC  IS  THERE  FURTHER  IL'PCRHATION  TO  BE  INPUT’t 

(0196) 

!•  (YES  OR  NO)  •/) 

iC197) 

READ(1,1002) IANS 

(0193) 

REWIND  6 

(0199) 

■ 

IFdANS.EQ.  »N»)  RETURN 

(0200' 

IF(IANS.NE.*Y»)  GOTO  900 

(0201) 

1002 

FORMAT(lAl) 

(0202) 

GO  TO  500 

(C203J 

END 

) ) J 
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(0204)  SUBROUTINE  INPSDR 

(020b)  C 

(0205)  C COMMON  BLOCK  FOR  THE  DIR  FILE 

(0205)  C ■ 

( 0205)  COMMON  TI T , PT I T ,D I R , RPT , DTtS YS , W AN, CON , ID » VEH» ACT»R 

(0205)  COMMON  CO MP  , RE V ,R DAT , WA 

10205)  C 

(0205)  C 

(C2C5)  C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(0205)  C 

(-C205)  INTE&ER*4  T I T ( 2 1 ) , P T IT  { 19  ) ,0 IR  ( 4 ) , RPT ( 4 ) ,S  YS  (3 ) ,CON  ( 5 ) , ID , AC T 

(0205)  INTEGER*4  COMP(21) 

( 0205)  INTEGER*2  D T ( 3 ) ,U AN { 4 ) , VEH ( 2 , 2 ) ,R , REV , RDAT ( 3 ) , WA ( 4 ) 

< 0205)  C 

(C20£)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  ■ 31  MAY,  1977 

O (0206)  NCLIST 

>31  (0207)  INTEGER*2  IER(3) 

Vjio  <020e)  C 

(0209)  C THIS  ROUTINE  PROVIDES  THE  BASIC  I/O  FOR  THE  INPUT/REVISE  ROUTINES 

10210)  C . ^ 

(0211)  IF(R.EQ.0)GOTO100 

(0212)  2 URITE(1,1) 

(0213)  1 ■ FORMAK*  HOW  MANY  ITEMS  DO  YOU  WISH  TO  REVISE  (MAX  OF  8)*,/) 

(0214)  READ(1,10,ERR=2)IKNT 

(02’5)  10  F0RMAT(I3) 

(0216)  IF(IKNT.LT.O)  GO  TO  2 

(0217)  IFdKNT.GT.S)  GO  TO  2 

(02183  DO  9999  L00P=1 , IKNT ,1 

(0219)5  WRITE ( 1 ,3 ) 

(02203  3 FCRMAT(‘  INPUT  THE  ITEM  NUMBER  THAT  YOU  WISH  TO  REVISE’,/) 

(0221)  READ(1,10,ERR=5)IR 

(0222)  C 

(0223)  C BEGIN  INPUT 

(0224)  C 

(0225)  100  IF(R.EQ.l.AND.IR.NE.l)  GO  TO  200 

(0226)  103  WRITE(1,101 ) 

( 0227)  101  F0RMAT(’  (1)  TITLE  (7  WORDS  - 1 0 CHA  R.  )•,/.*!*,  76  X ,»!»/ ) 

(C228)  LEN=10  • 
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NN, 


(0?29) 

CALL  TINPUT (TIT,LEN) 

(0230) 

URITEd  ,102)  TIT 

(C231) 

102 

F0RMAT(7(1X.2A9,A2)/) 

(0232) 

200 

IFtR.EG  .1.  AND  . IR.Nf:  .2  ) GO  TO  300 

(0233) 

IF(R.EQ.O)  GOTO  300 

f 023A) 

201 

URITEd, 202) 

(0235) 

202 

FORMATE*  (2)  DIR  OR  REPORT  NUMBER*,/ 

(0236) 

1*!*,19X,*!*/) 

(0237) 

READ (1, 203, ERR=201) DIR 

(0236) 

203 

FORMATE  IX, 3A9 ,A2) 

(C239) 

URITEd, 203)DIR 

(0290) 

300 

CONTINUE 

(0291) 

900 

IF(R.EQ.1.AND.IR.NE.3)  GO  TO  500 

(0292) 

901 

URITEd, 902  ) 

(0293) 

902 

FORMATE*  (3)  DOCUMENT  D ATE »,/,♦! HHDDYY !*/ ) 

(0299) 

READ(1,903,ERR=901)DT 

(0295) 

903 

F0RMAT(1X,3I2) 

(0296) 

URITEd, 903)DT 

(0297) 

500 

IF(R.EQ.l.AfJD.IR.NE.9)  GO  TO  600 

(0298) 

501 

URITEd, 502) 

(0299) 

502 

FORMATE*  (9)  SYSTEM*, 

(C2C0) 

IIX,* (ELEC,GSE,GUID,MECH,PROP,RF,SOP,HGS,EGS,PERF) *, 

(0251) 

1,/,3(*!*,9X, *!*)/) 

(0252) 

RE AD (1,50 3, ERR =501) SYS 

(0253) 

C 

CALL  CHKSYS (SYS, I ER) 

( 0 2 5 '( ) 

C 

DO  11  1=1,3 

(0255: 

C 

IFdER(I).EG.l)  GO  TO  501 

(0256) 

Cll 

CONTINUE 

(0257) 

503 

FCRMAT(1X,3(A9,2X)) 

(0258) 

URITEd, 503)  SYS 

(0259) 

600 

IF(R.EQ.l.ANO. IR.NE.5)  GO  TO  900 

(0260) 

601 

URITEd, 602  ) 

(026)  / 

602 

FORMATE*  (5)  U.A.  NUMBER/IO  CODE *,/*!* 8X, *!* /) 

(0262) 

REAO(1,603,ERR=601)  UAN 

(0263) 

URITEd, 603)UAN 

(0269) 

603 

F0RMAT(1X,9A2) 

( 02C5) 

CALL  GETCON 

(0266) 

660 

URITEd, 650  ) CON 

(0267)  650  FORHAT(1X,»CONTRACT  NUMBER  »»5AA) 

(0268)  9t0  1F(R.EQ.1.AND.IR.NE.6)  60  TO  2200 

(0269)  901  WRITE(1»902) 

(0270)  902  FORHATC  (6)  VEHI CLE » » /2 ( • ! !*)/) 

(0271)  READ(1»903,ERR=901)((VEH(I,J),J=1,2)»I=1»2) 

(0272)  903  F0RHAT(2(1X,I3»A1»1X)) 

(0273)  URITE(1*903)  ( ( VE H ( I » J) , J=1 , 2 ) ♦ 1=1 t 2 ) 

(C27A)  2200  CONTINUE 

( 0275)  IF(R.EQ.1.AND.IR.NF  .7)  GOTO  2300 

(0276)  WRITE(1,2201) 

(0277)  2201  FORMAT(»  (7)  R EV  1 S I ON  * , / » • ! !*/) 

(027R)  READ(1,2202)RFV 

(0279)  2202  FOR M AT ( 1 X » 1 A2 ) 

(0280)  URITE( 1,2202) 

(0281)  2300  IF(R.EQ.1.AND.IR.NE.8)  GOTO  9999 

O (0282/  230A  UR ITE( 1 ,230 1 ) 

_ I ( 0283)  2301  F0RMAT(»  (8)  REVISION  DA TE *,/,»! HMDDYY  !*,/ ) 

(0  28  A)  23  02  RE  A D ( 1 ,2  30  3 , ERR  = 23  0 4 ) R 0 AT 

(0285)  2303  F0RHAT(1X,3I2) 

(.0286)  URITE(1,2303)RDAT 

(0267)  5999  CONTINUE 

(0288'  CALL  SHOUDR 

(0289)  C 

(0290)  C-  END  OF  INPUT/REVISE  ITEMS  AS  OF  6/26/78 

(0291)  L 

(0292)  RETURN 

(0293)  END 
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SUBROUTINE  T INPUT ( T I L , LEN ) 

TITLE  PACK  ROUTINE 

THIS  ROUTINE  PACKS  THE  TITLF(S)  IN  A UNIFORM  MANNER 
FOR  LATER  STORAGE  AND  RECALL 


COMMON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT,PTIT,DIR»RPT,DT,SYS.UAN*CON,ID,VEH» ACT,R 
COMMON  COMP.REVtRDATfWA 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

I NT  EGER TIT(21),PTIT(19) , D I R ( A ) f RPT ( 4 ) ,S YS ( 3 ) « CON ( 5 ) * ID  . ACT 
INTEGER*^  C0MP(21) 

INTEGER *2  D T ( 3 ) ,U AN ( A ) , VEH ( 2 , 2 ) ♦ R , RE  V, RD AT ( 3 ) , UA ( A ) 

COMMON  /X/  PEDL 

INTEGER*A  AKRAY(A),BLNK,TIL(21) 

INTEGER *2  DUF(76)«BUFF(76),FEDL 
CALL  RDCOH(BUF) 

DO  5 I=li76 
BUFF(I)=BUF(I) 

CONTINUE 
BLNK=*  • 

DO  1 1=1,21 
TIL(I)=BLNK 
DO  11  1=1,20 
ARRAYd  )=f)LNK 
ARRAY(2)=BLNK 
ARRAY(3)=fiLNK 
ARRA Y( A )=BLNK 

CALL  GETWR0(3UF, ARRAY, LEN) 

TIL( 1)=ARRAY(1 ) 

TIL  ( I + l ) = ARR.AY(  2) 


SUBROUTINE  TINPUT ( T IL* LEN ) 


(032D) 

TIL(I*2)=ARRAY(3) 

<0321) 

TIL(I+3)=ARRAY(A) 

(0322) 

1 = 1 + 2 

(0323) 

12 

CONTINUE 

(032A) 

11 

CONTINUE 

(0325) 

PEDL=1 

(0326) 

DO  200  1=1,19 

(0327) 

200 

PTIT(I)=BLNK 

(0326) 

CALL  GETUD(DUFF,PTIT) 

'0329) 

211 

CONTINUE 

(0330) 

• 

RETURN 

(0331) 

END 

) ) 


1 


PAGE  002£> 


( 


SUBROUTINE  T INPUT ( T IL , L EN ) 


ACT 

J 

tl 

000175 

0301S 

ARRAY 

U 

000006 

0303S 

0313H 

0319M 

0315M 

0319 

0320 

0321 

BUNK 

J 

OOOA17 

03C3S 

C309K 

0311 

0313 

0327 

BUF 

I 

00001  6 

C3CAS 

0305A 

0307 

0317A 

BUFF 

I 

000132 

03  09  3 

030  7M 

0328A 

COMP 

J 

n 

000200 

0301S 

CON' 

J 

// 

000155 

0301  S 

DIR 

J 

// 

000120  . 

0 3 0 1 S 

DT 

I 

// 

OOOIAC 

0301  S 

^ GETV'D 

R 

EXTERNAL 

COOOOC 

G32fi 

GETURD 

R 

EXTERNAL 

000000 

0317 

I 

I 

000‘l2  1 

C306M 

0307 

0310M 

0311 

0320 

0321 

0322M 

032.6M 

ID 

J 

// 

000167 

0301  E 

o 

LEfJ 

i 

AK6UHENT 

OOOOQA 

0299S 

0317A 

1 

PEDL 

1 

ft/ 

OCOOOO 

C302S 

0309S 

0325M 

ro 

1£> 

PTIT 

J 

// 

000052 

C301S 

0327M 

0328A 

R 

I 

// 

000177 

0301  E 

Nj 

RDAT 

I 

// 

000253 

C301S 

kOCOM 

R 

EXTERNAL 

OOOOOO 

0305 

REV 

I 

// 

000252 

0301S 

RPT 

d 

// 

000130 

0301S 

SYS 

•J 

// 

0001A3 

C3C1S 

TIL 

J 

ARGUMENT 

000003 

0299S 

0303S 

0311H 

0318H 

TINPUT 

R 

OCOOOO 

0299S 

TIT 

d 

// 

000000 

0301  S 

VEH 

I 

// 

000171 

03C1S 

UA 

I 

// 

000256 

03  0 IS 

UAN 

I 

// 

000151 

0301  S 

_1 

000275 

0310 

0311D 

“li 

000357 

0312 

0329D 

Zl2 

000357 

C323D 

200 

000372 

0326 

03270 

“’ll 

00OA15 

03290 

5 

000256 

0306 

0308D 

PAGE  0027 

0316H  0317A  0316 

031A  0315  0316 


0312H  0318  0319 

0327 


0319M  0320M  0321H 
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PAGE  0026 


0000  ERRORS  t<^TlNPUT>FTN-REVlA.2  3 


OO 


I 


[ 


C READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 


PAGE  0029 


o 


^ - 

rsv  _ 

, 

V 


(0332)  C 
(0333)  C 
(0334)  C 
(0335) 
(0336)  C 
(0337) 
(0338)  C 
(0339) 

( 0340)  C 
(0341)  C 
(0342) 
(0343)  C 
(0344) 
(0345)  SO 
'0346)  100 

(0347) 
(0346) 
(0349) 

( 0353) 

(0351  ) 
(03521 
(0  353) 
(0354)  C 
(0355)  200 

(0356) 
(0357) 
(0358)  C 
(0359)  999 

(0360 
(0361) 
(0362) 


READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 


SUBROUTINE  ROCOH(BUF) 

COMMON  /X/  PEDL 

INTEGER  BUF(l) ,PEDL,CHAR,ANL»AKILL»AERASE 

ANLt  AKILL,  AERASE  ARE  OCTAL  212»  277«  242 
DATA  ANLfAKILL»AERASE/133,191»136/ 

PEDL=1 
N = 1 

CALL  CIIN(CHAR) 

BUF(N)=CHAR 

IF(CHAR.EO.ANL)  RETURN 
IF(CHAR.EQ. AKILL)  GOTO  90 
IF(CHAR.EQ. AERASE)  GOTO  200 
N = N*1 

IF(N.GT.77)  GOTO  999 
GOTO  100 

IF(N.LE.2)  GOTO  90 
N = N-1 
GOTO  100 

ILF=:212 
CALL  TIOU(ILF) 

RETURN 

END 


C-32 
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READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 


AERASE 

I 

000007 

0339S 

03421 

0350 

AKILL 

I 

000006 

0339S 

0342  1 

0349 

ANL 

1 

0000G5 

0339S 

C342I 

0 34  8 

BUF 

I 

ARGUMENT 

000003 

0335S 

C339S 

0347M 

Cl  IN 

R 

EXTERNAL 

000000 

0346 

CHAR 

I 

000071 

0339S 

0346A 

0347 

0348 

ILF 

I 

000072 

C359M 

0360A 

N 

I 

000073 

0 3 4 5 M 

0347 

0 351H 

0352 

PEDL 

I 

/X/ 

000000 

03T7S 

0339S 

0 34  4M 

RDCOM 

R 

000000 

0335  S 

TlOU 

R 

EXTERNAL 

000000 

0360 

_100 

000016 

0346D 

0 353 

0357 

200 

000051 

0350 

0355D 

_9  3 

000013 

G345D 

0349 

0355 

I999 

000062 

0352 

0359D 

0000  ERrtORS  t<RDCOM  >FTN-F;EV1A.  2 I 


) 

V < 


PACr  0030 


0349  0350 

0355  0356M 


[ 


C FETCH  ONE  ‘UORD*  FROM  BUFFER  FILLED  BY  RDCOH  PAGE  0031. 


(0363) 

C 

FETCH  ONE  »UORD*  FROM  BUFFER  FILLED  BY  RDCOH 

(036A) 

C 

(0365) 

c 

(0366) 

SUBROUTINE  GETURD ( BUF , NAMEtLEN) 

(0367) 

c 

(0368) 

COMMON  /X/  PEDL 

(0369) 

c 

(0370) 

INTEGER  BUF(l),PEDL,NAHE(l)iCHAR, 

(0371 ) 

♦ ANLiACOHMA»ASCOLtASP*ASPSP 

(0372) 

c 

(0373^ 

c 

ANL,ACOKHA,ASCOL»ASP,ASPSP 

(0376) 

c 

ARE  OCTAL 

(0375) 

c 

212*256»273i260, 120260 

(0376) 

c 

• 

(0377) 

DATA  ANL«AC0HHA«ASC0L/138tl72.187/» 

(0378) 

♦ ASP*ASPSP/16C*2H  / 

'037^) 

c 

r> 

(0380) 

DO  100  1=1,3 

1 

u> 

(0381) 

100 

NAMEd  )=ASPSP 

CO 

(0382) 

c 

\ 

(0383) 

N = 1 

(038-< ) 

IF(EUF(1) .NE.ASP)  GO  TO  200 

(0385) 

DO  999  1=2,77 

(0386) 

11=1-1 

• 

(0387) 

EUF(II)=BUF(I) 

« 

(0388) 

999 

CONTINUE 

(0309) 

200 

CHAR=BUF(PEDL ) 

(0390) 

PEDL=PEDL+1 

(0391 ) 

IF(PE0L.GT.77)  RETURN 

(03925 

IF(CHAR.EO.ANL)  GOTO  600 

(0393) 

IF  (CHAK.EQ.ASP.OR.CHAR.EQ.ACOMMA.OR.CHAR.EQ.ASCOL)  GOTO  300 

(0396) 

IF(N.GT.LEN)  goto  200 

(0395) 

I=(N*l)/2  . 

• ■ 

(0396) 

J=N-2*(N/2) 

(0397) 

N=N+1 

(0398) 

IF(J.EQ.l)  GOTO  250 

(039°) 

NAME(I)=LT(NAHE(I),e)  ♦ CHAR 

(0600) 

GOTO  200 

(0401) 

250 

NAME;(I)=  RT(NAKE(I)»8)  ♦ LS(CHAR,8) 

(0>02) 

GOTO  200 

(0403) 

C 

(C404) 

300 

CHAR=BUF(PEDL) 

(0405) 

IF(CHAR.EQ.ANL)  GOTO  400 

(0406) 

IF (CHAR .ME. ASP.AND.CHAR.NE.ACOHHA. AND.CHAR.NE.ASCOL)  RETURN 

(0407) 

PEDL=PEDL+i 

(0408) 

GOTO  300 

(0409) 

C 

(0410) 

400 

PEDL=77 

C041 1) 

* 

RETURN 

(0412) 

C 

(0413  • 

END 

C-35 
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C FETCH  ONE  ‘WORD*  FROM  BUFFER  FILLED  BY  RDCOH 


ACOMHA 

I 

000010 

C370S 

03771 

0393 

0406 

ANL 

t 

000007 

C370S 

03771 

0392 

0405 

ASCOL 

I 

oooon 

0370S 

03771 

0393 

0406 

ASP  , 

.1 

000012 

0370S 

03771 

0384 

0393 

0406 

ASPSP 

I 

000013 

03  70  S 

0377  1 

0 381 

RUF 

I 

ARGUMENT 

000003 

03ff.S 

0370S 

0 7.84 

0387H 

0389 

0404 

char 

I 

C0C2A3 

C370S 

0389M 

0 592 

0393 

0399 

0 401 

0404P 

C405 

0 4 0 6 

GETURD 

R 

OCOCOO 

0 3 6 6 S 

I 

I 

0002AA 

0 3 w 0 M 

036  1 

0385M 

0386 

0387 

0395H 

0399 

04  0 1 

II 

I 

000246 

03fl6M 

0387 

J 

I 

000247 

0396M 

0398 

LEM 

I 

ARGUMENT 

0 OOC05 

0366  S 

0394 

LS 

I 

EXTERNAL 

oococo 

0401 

L7 

I 

EXTERNAL 

000000 

0399 

N 

1 

000252 

C3P3M 

0394 

0395 

0396 

0397M 

NAME 

I 

ARGUMENT 

000004 

0366S 

0370S 

0381M 

0399M 

0401H 

PEOL 

I 

/X/ 

000000 

0368S 

0370S 

0389 

0390H 

0391 

0404 

0407H 

0410M 

RT 

R 

EXTERNAL 

000000 

0401 

_100 

000017 

0380 

03810 

_2D0 

000070 

0384 

0389D 

0394 

0400 

0402 

250 

000174 

0398. 

0 401D 

..30  0 

000207 

0393 

0404D 

0408 

_A0  0 

000240 

0392 

0405 

04100 

_999 

000061 

0385 

03880 

0000  ERRORS  t <GETURO>F TN-RE VI <1 . 2 3 


0033 


SUBROUTINE  GETUD ( BUFF t NAME ) 


(OAIA) 

SUBROUTINE  GE TUD ( B UFF , NA HE ) 

(OAIB) 

C 

(0A16) 

COMMON  /X/  PEDL 

J0A17) 

C 

C0A18) 

INTEGER  BUFF(l) ,PEDL»NAHE(1) ,CHAR, 

(0019) 

♦ ANL,ACOHHA,ASCOL,ASP,ASPSP 

(0020) 

C 

(0021) 

C 

ANL,  ACOMHA*  ASCOL,  ASr',ASPSP 

( 0022  ) 

C 

ARE  OCTAL 

(0023) 

C 

212»250,273  »200  .)  20200 

(0020) 

C 

(0025) 

DATA  ANL,AC0HHAiASC0L/138«172,187/» 

(0026) 

♦ ASP«AS?SP/160,2H  / 

(0027) 

C 

(0028) 

DO  100  1=1,19 

(0029) 

100 

NAMEd  )=ASPSP 

(0030) 

C 

(0031 > 

N = 1 

( 0.032) 

IF(BUFFd).NE.ASP)  GO  TO  200 

do 

(0033) 

DO  999  1=2,77 

cr» 

( 0030) 

11=1-1 

r< 

(0  035) 

BUFFdI)  = BUFFd) 

(0036) 

999 

CONTINUE 

(0037) 

200 

CHAR=BUFF (PEDL) 

(0038) 

PEDL=PEDL+1 

(0039) 

IF(PEDL.GT.77)  RETURN 

( OOOO) 

IF(CHAR.EQ.ANL)  GOTO  000 

(0001) 

I=(N+l)/2 

(0002) 

J=N-2* (N/2) 

(0003) 

N = N + 1 

(000  0) 

IF(J.EO.l)  C-OTO  250 

(0005) 

NAME  (I  )=LT(NAHE(I ),8)  ♦ CHAR 

(0006) 

GOTO  200 

(0007) 

250 

NAHEd)=  RT(NAME(I),8)  + LS(CHAR,8) 

(0008) 

GOTO  200 

(0009) 

C 

(0050  ) 

C 

(0051) 

000 

PEDL=77 

) 


I 
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SUBROUTINE  GETWD ( BUFF  , NAME  ) PAGE  0035 


(045?)  RETURN 

(0453)  END 


o 


subroutine;  geitwo  (buff  » name:  ) 


ACOfIMA 

I 

000007 

OAIOS 

0A25I 

ANL 

1 

000 006 

OAias 

0A25I 

OAAO 

ASCOL 

I 

000010 

OAies 

0A25I 

ASP 

I 

000011 

OA  IPS 

0A25I 

0A32 

ASPSP 

I 

000012 

OAICS 

0A25I 

0A29 

bUFF 

I 

ARGUMENT 

000003 

0 A 1 A S 

0A18S 

0*32 

0A35M 

CHAR 

I 

00016A 

OA  IPS 

0A37M 

0*A0 

CAA5 

GETUD 

R 

000000 

OAIAS 

.1 

I 

000165 

0P2PH 

0A29 

0A33M 

0A3A 

0AA7 

II 

I 

000167 

0A3AM 

0A35 

J ' 

I 

000170 

0 A A 2 M 

OAAA 

LS 

I 

EXTERNAL 

OOOOOC 

CAA7 

o 

LT 

I 

EXTERNAL 

CCOCCO 

OAPf. 

M 

I 

. ■ 

000171 

CA31M 

OAAl 

0AA2 

0AA3K 

NAME 

I 

ARGUMENT 

OOOOOA 

CAIAS 

0A18S 

0A29M 

0AA5H 

PEDL 

I 

n/ 

000000 

0A16S 

0A18S 

, 0A37 

0A38H 

<r 

RT 

R 

EXTERNAL 

000000 

QAA7 

_100 

000016 

0 A 2 P, 

0 A29D 

~’00 

000067 

CA32 

0A37D 

0AA6 

0AA8 

”250 

000 1A6 

CAAA 

0AA7D 

”aoo 

000161 

OAAO 

0A51D 

999 

000060 

0A33  . 

0A36O 

OAOO  ERRORS  C<GETWD  >FTN-RE V 1 A . 2 I 


) 

( • 
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0A37 

0AA7 

0A35  0441M  0AA5 


04A7M 

0A39  0A51M 
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SUBROUTINE  REVSDR 


PAGE  0037 


(045A) 
(0A55)  C 
(0A55)  C 
(0A55)  C 
(0A55) 
(0455) 
(0455)  C 
(0455)  ,C 
(0455)  C 
(0455)  C 
(0455) 
(0455) 
(0455) 
(0455)  , C 
(0456)  C 
(0456) 
(0457) 
(0458) 
(0459)  C 
(0460)  C 
(0461)  C 
(0462'  C 
(0463)  C 
(0464)  C 
(0465) 
(0466) 
(0,467) 
(0468) 
(0469)  4 

(0470  ) 
(0471) 
(0472) 
(0473)  3 

(0474)  C 
(0*75)  C 
(0476)  C 
(0477)  C 
(0478) 


SUBROUTINE  REVSDR 

COMMON  BLOCK  .FOR  THE  DIR  FILE 

COMMON  TIT,PTIT,DIR,RPT»DT»SYS«UAN*CON»ID*VEHtACT,R 
COMMON  COMP*REV,RDAT»UA 


DATA  DECLARATION  CLOCK  FOR  THE  DIR  FILE 

INTEGER *4  TIT(21),PTIT(19)tDIR(4)»RPT(4),SYS(3)»C0N(5)»ID.ACT 
INTEGER*4  C0KP(21) 

INTEGER  *2  D T ( 3 ) «W AN  ( 4 ) * VE H ( 2 » 2 ) t R » RE  V , RD AT ( 3 ) , UA ( 4 ) 

SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

INTEGER*4  IDIR(4) 

INTEGER»2  I OP T , F I N I SH , A < 1 5 ) , I T , I C 

THIS  IS  THE  REVISE  ROUTINE  FOR  THE  DIR  FILE 
note:  THIS  IS  LIMITED  AXCESS 

VALIDATE  THE  INCOMMING  USER 

CALL  TIMDAT(A,15) 

IF(A(13).E0.*JW'.0R.A(13).E0.»NH».0R.A(13).EQ.*RJ».0R. 

1 A(13).Efi.*DK* ) GO  TO  3 

URITE(1»4) 

FORMAT(»  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.*,/, 

1*  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT. 2621 

1.*) 

RETURN 

CONTINUE 

WHICH  DIR  DOCUMENT  IS  TO  BE  REVISED 
KEY  ON  THE  DIR  NUMBER 

FINISH=0 


SUBROUTINE  REVSDR 


PAGE  0036 


(0A79) 

5 

(0480) 

(0481) 

(0482) 

1 

(0483) 

(0484) 

2 

(0485) 

(0486) 

(0*87) 

(0488) 

100 

(Oipg) 
( 0490  ) 
(0491  ) 

lio 

(0492) 

(0493) 

1700 

( 0194  ) 

1800 

(0495) 

(0496) 

(0497) 

50 

(0498) 

1900 

(0499) 
(0500  ) 
(0501) 
(0502) 
(0503) 
(0504) 
(0505) 

2000 

(0506) 

(0507) 

(05CS) 

120 

(0509) 

(0510) 

125 

(0511) 

(0512) 

(0513) 

(0514) 

(0515) 

(0516) 

200 

URITEdtl) 

FORHAK*  PLEASE  INPUT  THE  SPO  DIR-REPORT  NUMBER  OF  THE  •»/ 

1*  DOCUMENT  TO  BE  REVISED*/) 

READ (l»2tERR=5> IDIR 
F0RHAT<3AA*A2) 

REWIND  6 

READ(6»END=200 )TIT,PTIT,DIR,DT,SYS»UAN*VEH,REVtRDAT 
IF(FINISH.EQ.l)  GOTO  125 
DO  no  I=1,A 

IF(IDIR(I).NE.DIR(I) ) GO  TO  125 

CONTINUE 

CALL  SHOWDK 

URITEC1»1700) 

FORMAK/,  lHC,/»  * IS  THIS  THE  CORRECT  RECORD  TO  BE  REVISED  OR  DELET 
1ED»»/**  ( YES  OR  NO)  •) 

READ<1,50>IOPT 
FORMAT (1A2) 

IF( lOPT.EQ. *NO*  ) GOTO  125 
IF { lOPT.NE. • YE» ) GOTO  1800 
URITE(1»2000) 

FORMAK*  IS  THIS  RECORD  TO  BE  REVISED  OR  DELETED**/^ 

1 * (REV  OR  DEL)  *) 

READ(1*50)  lOFT 
IFdOPT’.EO.'RE*)  GOTO  120 
IF( lOPT.NE. *DE* ) GOTO  1900 
FINISH=1 
GOTO  100 
,R  = 1 

CALL  INPSDR 
FINISH=1 

URITE(8)TIT.PTIT,DIR»DT,SYS»WAN,VEH,REV*RDAT 
GO  TO  100 
ENDFILE  8 

CALL  SRCH$$(KJCLOS, *DIR  *i6»0,0,0) 

CALL  SRCH3.$(KJDELE»*DIR  *t6»0tC,0) 

CALL  CNAH$I(*REVS  *,6i*DIR  *»G,IC) 

CALL  SRCHSl  (K$RDWR  + K$NDAH,*DIR  » , f. , 2 , IT  , I C ) 

CALL  SRCH$!,(K$RDWh+KlNDAM,*REVS  **6iA,IT»IC) 


I ‘ ■ 

'V  ~) 
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(0517)  C 
(051B)  C 
(0519)  C 

(0520)  RETURN 
(0521)  END 


:b 
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SUBROUTINE  REVSDR 
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■A 

I 

000002 

0A58S 

0A65A 

0466 

ACT 

J 

//  000175 

0A55S 

CNAMSt 

R 

EXTERNAL  000000 

C51A 

COhP 

J 

//  000200 

0A55S 

CON' 

J 

//  000155 

0A55S 

DIR 

J 

//  000120 

■ CA55S 

0A85M 

0A88 

0509 

DT 

I 

//  OOOHO 

0A55S 

0A85M 

0 509 

FINISH 

I 

0CC712 

0A58S 

0A78M 

0A86 

050AH 

0508H 

I 

I 

000713 

0A37M 

OAftS 

IC 

I 

000715 

CA5PS 

051AA 

0515A 

0516A 

ID 

J 

//  000167 

0A55S 

lOIF. 

J 

000021 

0A57S 

0A82M 

0488 

INPSDR 

I 

EXTERNAL  0000.00 

0507 

lOPT 

I 

000716 

0A58S 

0A9AM 

0A96 

0A97 

0501M  0502  0503 

IT 

I 

000717 

045PS 

0515A 

0516A 

KSALLD 

I 

PARAMETER 

CASES 

KiCACC 

I 

parameter 

0A56S 

KSCLOS 

I 

PARAMETER 

CA56S 

0512 

KSCONV 

I 

PARAMETER 

0A56S 

KSCURR 

I 

PARAMETER 

CA56S 

KSDELE 

I 

PARAMETER 

0A56S 

0513 

KSDHPS 

I 

PARAMETER 

0A56S 

KSOTIH 

I 

PARAMETER 

CA56S 

KSENTR 

I 

000000 

OA  56  S 

KSEXST 

I 

PARAMETER 

cases 

KJGCND 

I 

PARAMETER 

CA56S 

KSGPQS 

I 

PARAMETER 

0A56S 

KtHORF 

I 

PARAMETER 

CA56S 

KSICUR 

I 

PARAMETER 

0A56S 

KSI'IFO 

I 

PARAMETER 

0A56S 

KSIRTN 

I 

PARAMETER 

0A56S 

K J T.  S E G 

I 

PARAMETER 

0A56S 

KMUFD 

I 

PARAMETER 

0A56S' 

KSNEN  f 

I 

000000 

0A5C-G 

KSMSIZ 

I 

PARAMETER 

CASES 

KIHVNT 

I 

PARAMETER 

OASES 

KINDAH 

I 

PARAMETER 

0A56S 

0515 

0516 

KSNRTN 

I 

PARAMETER 

0A56S 

) 

» 

) ■ 
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KSNSAM 

I 

PARAMETER 

CA56S 

KSNSGO 

I 

PARAMETER 

0A565 

KSNSGS 

I 

PARAMETER 

0A56S 

KSPOSA 

1 

PARAMETER 

0a56S 

KSPOSN 

I 

PARAMETER 

CA56S 

KSPOSR 

I 

PARAMETER 

0A56S 

KSPREA 

I 

PARAMETER 

0A56S 

KIPRER 

I 

PARAMETER 

0A56S 

KSPROT 

I 

PARAMETER 

C A 5 6 S 

K1R9UR 

I 

PARAMETER 

0 A 5 6 S 

0515 

0516 

KIREAD,' 

I 

PARAMETER 

CA56S 

KIRPOS 

I 

P arameter 

CA56S 

KSRSU? 

I 

PARAMETER 

0A56S 

KSRWLK 

I 

PARAMETER 

0A56S 

KSSENT 

I 

000000 

CA56S 

KSSETC 

I 

PARAMETER 

0A56S 

KSSETH 

1 

PARAMETER 

GA56S 

KSSPCS 

I 

PARAMETER 

0A56S 

KSSRTN 

I 

PARAMETER 

0A56S 

KSTRNC 

I 

PARAMETER 

0A56S 

KSUPnS 

I 

PARAMETER 

CA56S 

KSURIT 

I 

PARAMETER 

0A56S 

PTIT 

J 

//  000052 

CA55S 

C485M 

0509 

R 

I 

//  000177 

0A55S 

0506M 

RDAT 

I 

//  000253 

CA55S 

0A85M 

0509 

REV 

I 

//  000252 

0A55S 

0485M 

0509 

REVSDR 

R 

000000 

0A5A  S 

RPT 

J 

//  000130 

0A55S 

SHOUDR  R EXTEIRNAL  0 0000  0 0A90 

SRCH$$  P EXTERNAL  000000  0512  0513  0515  0516 

SYS  J //  0001A3  0A5ES  0A85M  0509 

TTMOAT  R EXTERNAL  000000  . 0A55 

TIT  J /y  000000  0A55S  0AR5H  0509 

VEH  I //  000171  0A55S  0AB5M  0509 

UA  I /.'  000256  0A55S 

WAN  I //  000  15  1 0A55S  OARSf*  0509 


1 


000206 


0A79 


OA80D 
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100 

000300 

CA85D 

0505 

0510 

110 

0C0365 

0487, 

04890 

120  ' 

000571 

0502 

05060 

~125 

000577 

0A86 

0488 

0496 

17  0 0 

OOCACl 

CA91 

04920 

_180  0 

000A53 

04940 

0497 

_1900 

C0050C 

C4980 

0503 

2 

0C0270 

0482 

C483D 

_200 

000637 

0485 

05110 

_2000 

000505 

0458 

049°O 

_3 

000177 

04  66 

04730 

“a  . 

000100 

0468 

04690 

~5 

000202 

04750 

0482 

Iso 

000A62 

04  54 

0 4 9 5 D 

0501 

00  0 0 ERRORS  C<RE VSDR>FT N-R E Vl^i . ? j 
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(0522) 

SUBROUTINE  SHOWDR 

(05231 

C 

(0523) 

C 

COMMON  BLOCK  FOR  THE  DIR  FILE 

(0523) 

C 

(0523? 

COMMON  TIT,PTITiDIRiRPT,OT,SYStUAN»CON»IDtVEHtACT»R 

(0523) 

COMMON  COMP, REV, RDATtUA 

(0523) 

C 

(0523) 

C 

(0523) 

c 

DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(0523) 

r 

(0523) 

INTEGER*^  TIT(21) , F T I T ( 1 9 ) , BI R ( 4 ) , RPT ( 4 ) , S YS ( 3 ) , CON ( 5) , ID , ACT 

(0523) 

INTEGER*4  COMP(21) 

(0523) 

INTEGER*2  0T(3) ,WAN(4)  ,VFH(2,2) ,R,RtV,RDAT (3) ,WA(4) 

(0523) 

c 

. 

(052A) 

c 

(0525? 

CALL  CLEAR 

o 

( C52f.) 

URITE(1,10).  TIT 

1 

(0527) 

10 

F0RHAT(2X,*1.  TITLE:*,/,2X,7(1X,2A4,A2)) 

cn 

(052H) 

URITF(1,20)DIR,DT,SYS 

(0529) 

20 

F0RMAT(2X,»2.  • , 3 A4  , A2 , 5 X , • 3 . ♦ , 2 ( I 2, ♦ - ♦ ) , 1 2 , 1 3X , 

(0530) 

IM.  *,3(1X,A4)) 

(0531 ) 

WRITE (1,30)UAN, ( ( VEH ( I ,U) , J = 1 , 2 ) * 1 = 1,2) 

(0532) 

30 

F0RMAT(2X, *5.  • , 4 A2 , 1 1 X , • 6.  » , 2( 1 X , I 3 , A 1 , IX  ) ) 

(0533) 

URITE(1,40)REV,RDAT 

(0534) 

40 

FORMAT (2X, *7.  • , 1 A 2 , 1 7X , • 8 . » , 2 ( 12 , • -* ) , 12  ) 

(0535) 

RETURN 

(053b) 

• END 
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ACT 

U 

// 

000175 

0523S 

CLEAR 

R 

EXTERNAL 

000000 

0525 

COHO 

J 

n 

000200 

0523S 

CON 

J 

u 

000155 

0523S 

DIR 

J 

// 

000120 

0523E 

0528 

DT 

I 

// 

000140 

0523S 

0528 

I 

I 

000242 

0531  M 

ID 

J 

// 

000167 

C523S 

J 

I 

000243 

0531  M 

PTIT 

J 

// 

C00052 

0523S 

R 

' I 

// 

000177 

0523S 

RDAT 

1 

// 

000253 

0523S 

0533 

REV 

I 

// 

000252 

0523  5 

0533 

RPT 

J 

// 

000130 

C523S 

SHOUDR 

R 

OOOCOO 

0522S 

SYS 

J 

// 

000143 

0523  S 

0528 

TIT 

J 

// 

000000 

0523S 

0526 

VEH 

1 

// 

000171 

C523S 

0531 

UA 

I 

// 

000256 

0523  S 

VAN 

1 

// 

000151 

C523S 

0531 

10 

000012 

0526 

0527D 

_2  0 

000052 

052F 

052°P 

Iso 

000153 

0531 

05320 

_4  0 

000213 

0533 

05340 
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(0574) 
t0575> 
(0576) 
(0577) 
(0578} 
(0579) 
(0580) 
(05813 
(0582) 
(0583) 
(0584) 
( 0585) 
(0586) 
(0587) 
(0588) 
(0589) 
(0590) 
(0591) 
(0592) 
(0593) 


10 

11 


15 

20 


CALL  CLEAR 
WRITE(1»1 > 
REWIND  6 
GO  TO  6 
WRITE(1*11) 


F0RHAT(»  DO  YOU  WANT  A HARO  COPY  OF  THE  INFORMATION  FOUND*, /»' 
1*  (YES  OR  NO)') 

CALL  SRCH$$(K$CLOS, 'OUT  *,6,0, 0,0) 

READ(1,3)  IDES 

IF  (IDESd  ) .EG.  • YE*  ) GO  TO  20 
IF(IDES(l).EO.*NO*)  GO  TO  15 
GO  TO  10 

CALL  SRCH$$(K$DELE, 'OUT 
RETURN 

CALL  SRCH$$(K$CLOS, 'DIR 
CALL  SRCHIS(K$CLOS,*REVS 
CALL  SRCH$$ (KSCLCS, 'TEMP 


',6, 0,0,0) 


*,6,0, 0,0) 
*,6,0, 0,0) 
*,6,0, 0,0) 


CALL  CCMISSCSCUT 

CALL  EXIT 

END 


*,6,12,10 
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X:) 


ALDR 

R 

external  000000 

0565 

CLEAR 

R 

EXTERNAL  000000 

0574 

COMI JS 

R 

EXTERNAL  COOOOC 

0591  ■ 

CONN 

R 

EXTERNAL  000000 

0571 

DATDR 

R 

EXTERNAL  000000 

0568 

DIRN 

R 

EXTERNAL  000000 

0567 

EXIT 

R 

EXTERNAL  OOOOOO 

. 0592 

IC 

I 

000673 

0539S 

0591, 

IDES 

I 

■000002 

0539S 

05631 

0570 

0571 

IT 

I 

000000 

0539S 

J 

I 

000674 

05^4M 

0545 

KSALLD 

I 

PARAMETER 

0538S 

KSCACq 

I 

PARAMETER 

0536S 

KSCLOS 

I 

PARAMETER 

C538S 

0581 

KSCONV 

I 

PARAMETER 

0535S 

KSCURR 

I 

PARAMETER 

053tS 

KSOELE 

I 

PARAMETER 

053tS 

0586 

K$OM=S 

T 

parameter 

053E.S 

KIDTIM 

I 

PARAMETER 

C53PS 

KSENTR 

I 

OOOOOO 

053PS 

KSEXST 

I 

PARAMETER 

0536S 

KSGOND 

I 

PARAMETER 

0538S 

KSGPOC 

I 

PARAMETER 

0538S 

KSHOME 

I 

PARAMETER 

0538S 

KSICUR 

I 

PARAMETER 

C538S 

ksimfd 

I 

PARAMETER 

0538S 

KSIRTN 

I 

PARAMETER 

G538S 

K$is:c- 

I 

PARAMETER 

C53PS 

KSIUFD 

I 

parameter 

C53GS 

KSMENT 

I 

OOOOOO 

0538S 

KSKSIZ 

I 

PARAMETER 

053PS 

KSMVNT 

I 

PARAMETER 

0536S 

KSNDAM 

I 

PARAMETER 

053SS 

XSNRTN 

I 

PARAMETER 

053RS 

KSNSAH 

I 

PARAMETER 

053CS 

0543 

KINSGD 

I 

parameter 

0538S 

KSNSGS 

I 

PARAMETER 

05388 

0565 

0572 


0588 


0566  0567  0568 

0573  0582M  0583 


0589  0590 


0569 

0584 
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kjpoSa 

I 

f>ARA^1ETER 

0538S 

KJPOSN 

I 

PARAMETER 

0538S 

KSPOSR 

I 

PARAMETER 

0536S 

KSPREA 

I 

PARAMETER 

05  3PS 

KSPRER 

I 

PARAMETER 

C538S 

KSPROT 

I 

PARAMETER 

053P.S 

KSROUR 

I 

PARAMETER 

053BS 

0563 

KSREAO 

I 

PARAMETER 

053P.S 

K$R°0S 

I 

PARAMETER 

053&S 

KSRSUB 

I 

PARAMETER 

C538S 

KSP.VLK 

I 

PARAMETER 

0538E 

KSSENT 

I 

OOOOOC 

0 5 3, 0 s 

KSSETC 

I 

PARAMETER 

C538S 

KSSETH 

I 

PARAMETER 

C53SS 

KSSPOS 

I 

PARAMETER 

0539  S 

KSSRTN 

I 

PARAMETER 

0538S 

KSTRNC 

I 

PARAMETER 

0538S 

KSUPOS 

I 

PARAMETER 

C536S 

KSWRIT 

I 

PARAMETER 

0538S 

SEADR 

R 

000006 

0537S 

SRCHSS 

R 

EXTERNAL  000000 

0563 

0581 

0586 

SYSOR 

R 

EXTERNAL  OCOOOO 

0570 

TI7DR 

R 

EXTERNAL  OOOOOC 

0566 

VEHN 

R 

EXTERNAL  000000 

0572 

UANLIM 

•R 

EXTERNAL  000000 

056R 

_1 

COODAl 

0567 

05680 

0575 

10 

000521 

0573 

C578D 

0585 

”ll 

0C0525 

0578 

C5790 

_15 

000622 

0586 

05860 

“20 

00063A 

0583 

C588D 

_3 

000A26 

0563 

0566D 

0562 

_6 

000A16 

C563D 

0577 

9999 

000030 

0565 

0566D 

0588 


0589 
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(059At 
(C595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0595) 
(0596) 
(0596) 
(0597) 
(0598) 
(0599) 
(0600) 
(0601) 
(0602) 
(U603) ' 
( 060^1) 
(0605) 
(0606) 
(0607) 
(0608) 
(0609) 

( 06<  0) 
(0611) 
(0612) 
(0613) 
(0619) 
(0615) 
(0616) 
(0617) 
(0618) 


SUBROUTINE  TITDR 
C 

C COMMON  block  FOR  THE  DIR  FILE 

C 

COMMON  TIT,PTIT,DIR.RPTtDT,SYS,WANiCON,ID,VEHtACT»R 
COMMON  COMP»REV,RDAT,WA 
C 

C • 

C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

C 

INTEGER*^  TIT(21) ,?TIT(19)»DIP,  (A),RPT(A) tSYS(3)»C0N(5) »IO»ACT 
INTEGER**)  C0MP(21) 

INTEGER*2  DT ( 3 ) i W A N ( 6 ) , VE H ( 2 » 2 ) * R » RE V, RD AT ( 3 ) ♦ WA ( A ) 

C • 

C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAYi  1977 

NOLIST 

C 

c ■ ■■ 

C THIS  IS  THE  TITLE  SEARCH  ROUTINE  FOR  THE  DIR/REPORT  FILE 

INTEGER**!  IT(21) 

INTEGER *2  CONT , DOC » T1 » IN , I CON , 10 » lOPT » I T Y» I C 
INTEGER**!  BLNK 
T1  = 0 

CALL  CLEAR 
1001  U'RITE(1,2) 

2 FORMAT!*  HOW  MANY  WORDS  DO  YOU  WISH  TO  HATCH  (MAX  OF  A)*,/ 

1/) 

READ(1.8*rRR=1001 )ICON 
8 F0RHAT(I2) 

IF(  ICON.LT. 1 ) GO  TO  1001 

IF(ICON.GT.A)  GO  TO  1001 

DO  1000  LOOP=1,1CON 
WRITE(lfl) 

1 FORMAT!*  WHAT  IS  THE  DESIRED  WORD*f//) 

LEN=10 

CALL  TINPUT(IT,LEN) 

IF(IT(1).EQ.*QUIT*  ) GO  TO  1002 
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1^ 


0 

1 

oi 

r\> 


(0619) 

CALL  SRCH$$ (K$RDUR  + K$NDAH»«T1  * » 6 *7 » ITY * I C) 

(0620) 

CALL  SRCH$$(K$RDWR  + KSNDAH,*T2  • « 6 1 8 , ITY , I C) 

(0621) 

IF(Tl.EQ.O)  IN=6 

(0622) 

IF(Tl.EO.O)  10=11 

(0623) 

IF(Tl.EQ.l)  IN=11 

(C62A) 

IF  (T1.E3. 1)10=12 

(0625) 

IF(T1.EQ.2)  IN=12 

(0626) 

IF(T1.EQ.2)  10=11 

(0627) 

IF(T1.EC.3)  IN=11 

(0628) 

IF(T1.E0.3)  10=12 

(0629) 

IF(T1.EQ.4)  IN=12 

(0630) 

IF(T1.EQ.4)  10=11 

( 0631  ) 

DOC  = 0 

(0632) 

ROVIND  IN 

(0633) 

REWIND  10 

(0634) 

5 

READ(IN,END=100)TIT,PTIT,0IR*DT»SYS,WAN,VEH,REV*RDAT 

(0635) 

BLNK=*  * 

(0636) 

DO  3 I=lt21 

( 0637) 

IF(TIT(I).EQ.BLNK)  GO  TO  3 

(0638) 

IF(TIT(I).NE.IT(D)  GO  TO  3 

(0639) 

IF(TIT{I+1).E3.BLMK)  GO  TO  4 

(0640) 

IF(IT(2).EQ.5LNK)  GO  TO  4 

(0641) 

IF  ( TIT( 1*1 ) .EQ. IT (2) ) GO  TO  4 

(0642) 

3 

CONTINUE  ■ 

(0643) 

GO  TO  5 

(0644) 

4 

D0C=D0C+1 

(0645) 

WRITE(IO) TITtPTIT,DIR,DT,SYStWAN»VEH»REV*RDAT 

(0646) 

URITE(1,10)TIT 

( 06^*7) 

10 

F0RHAT(1X,7(2A4,A2«1X)) 

(0648) 

GO  TO  5 

(0649) 

100 

WRITE(1,103C>DOC,IT 

(0650) 

1030 

FORHAT(*  THERE  AP.E»,I5,*  DOCUMENTS  CONTAINING  THE  WORD 

(0651) 

17(1X,2A4,A2)//) 

(0652) 

IF(DOC.E3.0)  GOTO  1020 

(0653) 

ENDFILE  10 

(0654) 

CALL  SRCHJ KKSCLOSi  *T1  *t6»0,0»0) 

(0655) 

CALL  SRCH1$(K$CL0S, *T2  »t6»0,0»0) 

(0656) 

IF(IO.EQ.ll)  CALL  SR  CHI  $ ( K J DELE t ' T2  *i6, 0*0.0) 
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<0657)  1F(I0«EQ.12)  CALL  SRCH S$ ( K SDELE » • T1  *t6»0t0»0) 

(0658)  T1=T1*1 

(0659)  1000  CONTINUE 

(0660)  1002  CALL  SRCH$$ ( K$ROWR+K$NDAM, *T1  • , 6 . 7 » I T Y » I C ) 

(0661)  CALL  SRCHtS(KlRDWR+K$NDAK,*T2  • » 6 » 8 * IT Y , I C ) 

(0662)  IFOOCiLT.l)  GO  TO  1020 

(0663)  DO  9999  1=1. DOC 

(0  66 A)  READ(  IO,END  = 102D)TIT,PTIT»CIR»DTfSYS,UAN»VEH»REV,RDAT 

!0665)  CALL  FMAIM 

(0666)  9999  CONTINUE 

( 0667)  1020  CONTINUF. 

(0668)  CALL  SR CH$$ ( K SCLOS , • T 1 »,6»0»0»0) 

(0669)  CALL  SRCHJ $ ( KS CLCS « • T 2 'tStOtOfO) 

(0670)  CALL  SRCH5,S(KJDELE«  »T1  »,6»0,C«0) 

(0671)  CALL  SRCHSS (KIDELEt *T2  *»6*0,0»0) 

(0672)  T1=0 

(0673)  IF(DOC.NE.O)  RETURN 

(067A)  1999  WRITE(1»2000) 

(0675)  2000  FORMAT(*  DO  YOU  WISH  TO  TRY  THE  TITLE  SEARCH  AGAIN  (YES  OR  NO)*) 

(0676)  REAO<1,20C1)IOPT 

(0677)  2001  F0RMAT(1A2) 

(0678)  IFdOPT.EQ.  *YE*)  GOTO  1001 

(0679)  IFCIOPT.NE.’NO*)  GOTO  1999 

(0680)  ■ RETURN 

(0681)  END 
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ACT 

J 

//  000175 

0595S 

BLNK 

J 

001170 

0603S 

0635M 

0637 

0639 

CLEAR 

R 

EXTERNAL  000000 

0605 

CORP 

J 

//  000200 

0 5 9 5 S 

CON 

J 

//  000155 

0595S 

CONT 

I 

000000 

06  0 2 S 

DIR 

J 

//  000120 

0595S 

063AM 

06*5 

066*M 

DOC 

I 

C01172 

0S02S 

0673 

0631M 

06**H 

06*9 

DT 

I 

//  OOOIAO 

C5°5S 

0634M 

06*5 

0664H 

FHAIN 

R 

EXTERNAL  000000 

0665 

I 

I 

001173 

C63F  M 

0637 

0638 

0639 

IC 

I 

001175 

06023 

0619A 

0620A 

0660A 

ICON 

I 

001176 

C6C2S 

0609M 

0611 

0612 

ID 

■J 

//  000167 

0 5 9 5 S 

IN 

I 

001177 

C6G2S 

.063* 

0 621M 

C623M 

0625H 

10 

1 

001200 

0602S 

C622M 

062*M 

0626M 

06*5 

0653 

0656 

0657 

I OPT 

I 

001201 

0602S 

0676M 

0676 

0679 

IT 

J 

000002 

P6G1S 

0617A 

0618 

0638 

ITY 

I 

001202 

06023 

0619A 

0620A 

0660A 

KSALLD 

I 

PARAMETER 

g c c c 

KSCACC 

I 

PARAMETER 

05963 

KSCLOS 

I 

PARAMETER 

0 5 9 6 S 

065* 

0655 

0668 

KSCONV 

I 

PARAMETER 

0 5 9 6 3 

KSCURR 

I 

PARAMETER 

05963 

KSDELE 

I 

PARAMETER 

0 59  6 3 

0656 

0657 

0670 

KSDMPB 

I 

PARAMETER 

C596S 

KSDTIM 

I 

PARAMETER 

0596S 

KSENTR 

I 

000000 

0596S 

KSEXST 

I 

PARAMETER 

05  9 6 3 

KIGOND 

I 

PARAMETER 

05963 

KSGPOS 

I 

P ARAMETER 

0596S 

KSHOME 

I 

PARAMETER 

C596S 

KSIC'JR 

I 

PARAMETER 

C596S 

KSIMFD 

I 

PARAMETER 

05963 

KSIRTN 

I 

PARAMETER 

0596S 

) 
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06A0 


0652  0662  0663 


06*1 

0661A 

0613 

0663H 

0627M 

0629M 

0632 

0 628H 
066* 

Q630M 

0633 

06*0 
0661  A 

06*1 

06*9 

0669 

0671 

SUBROUTINE  TITDR 


PAGE  0053 


o 


KSISEG 

I 

parameter 

0596S 

KSIUFD 

I 

PARAMETER 

0596S 

KSMEMT 

I 

000000 

0596S 

KSHSIZ 

I 

PARAMETER 

0596S 

KSMVNT 

I 

PARAMETER 

C596S 

KSNOAH 

I 

PARAMETER 

0556S 

0619 

0620 

0660 

KSNRTN 

I 

PARAMETER 

0596S 

k$nsa:i 

I 

PARAMETER 

0596S 

KINSCO 

I 

PARAMETER 

0R96S 

KSNSGS 

I 

PARAMETER 

0596S 

ksposa' 

I 

PARAMETER 

0596S 

KSPOSN 

I 

PARAMETER 

0596S 

KSPOSR 

I 
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(0682)  SUBROUTINE  ALDR 

(0683)  C 

(0683)  C COMMON  BLOCK  FOR  THE  DIR  FILE 

(0683)  C 

(0683)  ' COMMON  TI T , PT I T ,DI R t RPT , DT ,S YS t U AN , CON 1 1 D « VEH , ACT  * R 

(0683)  COMMON  COMP , RE V . RD A T » UA 

(0683)  C 

(0683)  C 

(06835  C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(0683)  C 

(0683)  INTEGER*^  T I T ( 2 1 ) » PT IT ( 1 9 ) . DI R ( A ) , RPT ( A) , S YS ( 3 ) , CON ( 5 ) * ID t ACT 

(0683)  INTEGER»A  COMP(21) 

(0683)  INTEGER*2  D T ( 3 ) »W AN ( A ) t VEH ( 2 , 2 ) ♦ R * R EV , RD AT ( 3) ♦ WA ( A ) 

(0683)  C 

(C68A)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY,  1977 

t068A)  NCLIST 

(0685)  C 

(0686)  INTEGER*2  lOPT 

(0687)  C 

(0688)  C PRINT  ALL  ROUTINE 

(0689)  C 

(06905  INTEGER*A  KNT 

(0691)  KNT=0 

(0692/  CALL  BR EA K1 ( . TRUE . ) 

(0693)  URITE(1,1) 

(069AJ  1 FORMAT(»  THIS  IS  THE  PRINT  ALL  ROUTINE  *,/, 

(0695)  1 • ALL  DOCUMENTS  STORED  IN  THE  DIR  FILE  WILL  DE  SPOOLED’./ 

(0696)  2’  AND  A TOTAL  COUNT  OF  THE  DOCUMENTS  WILL  DE  GIVEN’,//) 

(0697)  2 WRITE(1,3) 

(0698)  3 FORMAK’  ',/,’  YOU  HAVE  A CHOICE  OF  T'JO  (2)  OPTIONS.  OF  OUTPUT  ’, 

(0699)  l’F0RHATS.’,/,6X,’(l)  FULL  LISTING  OF  ALL  FIELDS  FOR  EACH  ’, 

(0700)  I’OIR  RECORD’, /, 6X, ’ (2)  BRIEF  LISTING  OF  DIR  NUMBER  AND  REVISION’, 

(0701)  1’  ONLY’,/,’  ENTER  OPTION  (1  OR  2)’) 

(0702)  READ(1,A,ERR=3) lOPT 

(0703)  A F0RMAT(I2) 

(07Ca)  IFdOPT.LT.l  .OR.IOPT.GT.2)  GO  TO  2 

(0705)  20  REAO(6,END=10b) TIT.PTIT,DIR,DT,SYS,UAN,VEH,REV,RDAT 

(0706)  KNT=KNT+1 


J J 
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(0707)  IF(I0PT.EG.2)  GOTO  25 

(0708>  CALL  FMAIN 

(0709)  GO  TO  20 

(0710)  25  IF(REV.EQ.»  •)  GOTO  50 

(0711)  URITE(7,35)  KNT,DIR,RCV 

(0712)  35  FOKMAT(2X, in, 2Xt 3AA , A2,5X, *REV  ’tlAP) 

(0713)  GO  TO  no 

(071A)  50  WRITE(7,55)  KNTtOIP 

(0715)  55  FORHAT(2X,I8,».*,2X,3AA,A2) 

(0716)  60  IF(KNT/50.Erj.KNT/50.  ) URITE(1,70>  KNT 

(0717)  70  F0RMAT(2X,IR) 

(0718)  . GO  TO  20 

(0719)  100  WRITE(1»200)  KNT 

(0720)  200  FORMATC  THERE  ARE  *19*  DOCUMENTS  IN  THE  DIR  FILE*,/) 

(0721  ) CALL  SRCHJl(K$CLOS,*OUT  *, 6, 0,0,0) 

(0722)  CALL  SRCKIJ ( K$ CLO S , * DI R *,f, 0,0,0) 

(0723)  CALL  SRCH IS ( KSCLO S , * RE VS  *,6,0, 0,0) 

(0724)  CALL  SRCH $$( KSCLOS ,* TEMP  *,6,0, 0,0) 

(0725)  CALL  COMISl(*SOUT  *,6,12,10 

(0726)  CALL  EXIT 

(0727)  END 
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(0728) 
(0729)  C 
(0729)  C 
(0729)  C 
(0729) 
(0729) 
(0729)  C 
(0729)  C 
(0729)  C 
(0729)  C 
(0729) 

(0  72'9) 
(0729) 
(0729)  C 
(0730)  C 
(0731)  C 
(0732)  C 
O (0733)  C 
(373A)  C 
(0735) 
(0736) 
(0737) 
(0738)  1 

(0739)  2 

(0740) 
(07*1)  3 

(07A2)  999 

(07A3)  100 

( 07AA) 
(0745)  998 

(0796)  102 

(0797) 
(0798) 
(0799)  101 

(0750) 

(0751)  • 
(0752) 
(0753)  9 


SUBROUTINE  VEHN 

COMMON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT,PTIT,DIR,RPT»DT,SYS,WAN,CON,ID»VEH,ACT,R 
COMMON  COMPiREV*RDAT,UA 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

INTEGER *9  T I T ( 2 1 ) , P T IT ( 1 9 ) » C I R ( 9 ) , RPT ( 9 ) ,S YS ( 3 ) » CON ( 5 ) , ID , ACT 
INTEGER*9  C0MP(21) 

INTEGER*2  D T ( 3 ) < W AN ( 9 ) , VEH ( 2 » 2 ) , R » RE V, RD AT ( 3 ) » WA ( 9 ) 


THIS  ROUTINE  LOCATED  ALL  ENTRIES  IN  THE  DIR/REPORT  FILE 
WHICH  ARE  RELATED  TO  EITHER  A SPECIFIC  VEHICLE  OR  VEHICLE 

INTEGER«2  VEHl ( 2 ) , VS ( 9 ) , VKNT 
VKNT  = 0 
CALL  CLEAR 
WRITE(1»2) 

FORMAT(»WHAT  IS  THE  DESIRED  VEHICLE  NUMBER*) 

READ(1,3,EPR=1) VEHl 

F0RMAT(2(I3,A1)) 

WRITE(1»100) 

FORMAT(*WHAT  IS  THE  FIRST  VALID  VEHICLE  NUMBER**/) 

READd*  101 1 ERR=100)  (VS(I  )«  1 = 1,2) 

WRITE(1,102)  . 

FORMAT(*WHAT  IS  THE  LAST  VALID  VEHICLE  NUMBER*,/* 
l*NOTE  - THE  DEFALT  IS  VEHICLE  999*) 

READ(1,101,ERR=998) (VS(I),I=3,9) 

FORMAK I3,A1,2X,I3,A1) 

IF ( VEHl (1 ) . LT.  VS( 1 ) ) GO  TO  999 
IF(VS(3).EC!.0)  VS(3)=999 
IF(VS(3).LT.VEH1(1>)  GO  TO  998 

READ(6,ENO=202) TIT,PTIT,DIR,DT,SYS,UAN,VEH,REV,RDAT 
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(075A)  IF{VEH(1,1).LT.VS<1>)  GO  TO  A 

(0755)  1F(VEH(2, 1) .GT.VS<3)  ) GO  TO  A 

(0756)  IF(VEH(l,2).rjE.»S».AND.VEH(l,l).EQ.VEHl(l))  GO  TO  1001 

(0757)  IF(VEH(1,2).EQ.*S».AND.VEH(1,1).LE.VEH1(1))  GO  TO  1001 

(0758)  GO  TO  A 

(0759)  1001  VKNT=VKNT*1 

(0760)  caul  FHAIN 

(0761)  GO  TO  A 

(0762)  202  URITE(1.201)VKNT,VEH1 

(0763)  201  FORMAT( *THERE  ARE  MIO*  OIR/REPORTS  RELATING*, /t 

(07CA)  l*TO  VEHICLE  *13, Al/) 

(0765)  RETURN 

(0766)  END 
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SUBROUTINE  UANUH 

eOMHON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT,PTIT,Dia,RPT,DT,SYS,WANtCON«IO»VEH»ACTiR 
COMMON  COMP»REV,RDAT,UA 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

INTEGER* A T I T ( 2 1 > »P T I T ( 19 ) * DI R ( A ) t RPT ( A ) ,S YS ( 3 ) . CON < 5 ) .ID. ACT 
INTEGER*A  COMP(21) 

INTEGER *2  DT(3).UAN(A).VEH{2»2).R.REV,RDAT(3).WA(A) 


HIS  ROUTINE  LOCATES  ALL  DOCUMENTS  WITH  A SPECIFIED  U.A.  NUMBER 

INTEGER*2  DWA(A).KNT 
KNT  = 0 

WRITEd.l) 

FORMAT!’  WHAT  IS  THEOESIRED  WA  NUMBER’./) 

READ(1.2*ERR=3)DUA 

FOP.MAT<AA2) 

READ(6.END=200)TIT.PTIT,DIR.DT.SYS,WAN.VEH.REV.RDAT 
IF<DWA(A> .NE.’  ’)  GOTO  5 

IF(0«A(3) .NE.’  »)  GOTO  AO 

DO  30  1=1,2 

IF <DWA( I) .NE.UAN! I ) ) GOTO  100 
CONTINUE 
GO  TO  15 
DO  50  1=1.3 

IF (DWA( I) .NE.UAN! I ) ) GOTO  100 
CONTINUE 
GO  TO  15 
DO  10  !=1,A 

IF(DWA(I> .NE.UAN(I) ) GO  TO  100 
CONTINUE 
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(07^3)  15  CALL  FMAIN 

(0794)  KNT  = KNT-*-l 

(0795)  GO  TO  100 

(0796)  200  URITEd »250)KNT,DWA 

(0797).  250  FORHAT(»  THERE  ARE  ’lO*  DOCUMENTS  WITH  A U.A.  NUMBER’, 

(0798)  1»  OF  »4A2) 

(0799)  RETURN 

(0800)  END 
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0 00  1 91 

0 7 8 2 

0 7 H 9 D 

_A0 

000  150 

0781 

0 78  CD 

Is 

000  166 

07  80 

07900 

so 

000157 

0786 

0788D 
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0783  0787  0791 

0790M  0791 


0791 

0795 
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o 

vs 


(080i> 

(0802) 

C 

(0802) 

C 

(0802) 

C 

(0802) 

(0802) 

(0802) 

C 

(0802) 

C 

(0802) 

C 

(0802) 

C 

(0802) 
(0802) 
( 0802) 
(0802) 

C 

(0803) 

. C 

(OeOA) 

C 

(0805) 

C 

(0806) 

C 

(0807) 

(0808) 

(0805) 

20 

(0810) 

21 

(0811) 

(0812) 

22 

(0813) 

ICO 

(081A) 

(0815) 

(0816) 

(0617) 

110 

(0813) 

(0819) 

120 

(0820) 

(0821) 

130 

(0822) 

(0823) 

(082A) 

130 

(0825) 

(0826) 

160 

SUBROUTINE  DATDR 

COMMON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT,PTIT,DIR ,RPT,DT,SYS .WAN,C0NfID*VEH, ACTfR 
COMMON  C0KP4REV,RDAT,U'A 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

INTEGER*A  T I T ( 2 1 ) , PT IT ( 1 9 > « 0 1 R < A ) t RPT ( A ) , S YS ( 3 ) ♦ CON < 5 ) » ID » ACT 
INTEGER*A  C0MP<2I ) 

INTEGER*2  D T ( 3 > ,W AN ( A ) , VEH < 2 » 2 ) t R, RE Vi RO AT ( 3 ) t WA ( A ) 


THIS  ROUTINE  LOCATED  ALL  DOCUMENTS  WITH  A SPECIFIED  DATE 

INTEGER*2  0(3) 

KNT  = 0 

WRITE<li21) 

F0RMAT(»  L'HAT  IS  THE  DATE  THAT  YOU  WANT  • t/ 1 ♦ 'MMDDYY  ! • / ) 

READ(li22iERR=20) D 

FORMAT(lXi3I2) 

REAO(6iEND=2QO) TITiPTITiDIRiDTiSYStUANi VEHiREViRDAT 

IF(REV.EQ.*  *>  GOTO  150 

IF(D(1) .EG.O)  GO  TO  110 

IF(Dd)  .NE.OTd))  GO  TO  100 

IF(D(2) .EQ.O)  GO  TO  120 

IF(D(2).NE.DT(2))  GO  TO  100 

IF(D(3).EQ.G)  GO  TO  130 

IF(D(3).NE.DT(3))  GO  TO  100 

CALL  FMAIN 

KNT=KNT+1 

GO  TO  100 

IF(Dd).EQ.O)  GOTO  160 
IF(Dd).NE.RDAT(l))  GOTO  100 
IF(D(2) .EQ.O)  GOTO  170 
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(0827J 

1F(D(2).NE.RDAT(2)) 

GOTO 

(0828) 

170 

IF(0(3).ES.O)  GOTO 

130 

(0829) 

IF (D(3) .NE.RDAT(3) ) 

GOTO 

(.0830) 

GO  TO  130 

(0831  ) 

200 

WRITEd  »250  )XNT,D 

(0832) 

250 

FORMAT!*  THERE  ARE 

f 19* 

(0833) 

RETURN 

(083A) 

END 

100 

100 

DOCUMENTS  WITH  A DATE  OF  • 2 < I 2 • -* ) . 1 2 > 


C-71 


SUBROUTINE  DATOR 


ACT 

J 

N 

000175 

0B02S 

COMP 

J 

// 

000200 

C802S 

CON 

J 

// 

000155 

0802S- 

D 

I 

000002 

C807S 

0811K 

,0815 

0820 

082A 

0825 

08  31 

DATOR 

R 

000000 

0 9 0 1 S 

DIR 

J 

// 

000  120 

C8C2S 

0813M 

ot’ 

I 

// 

OOCIAO 

P802S 

0813M 

0816 

FMAIN 

R 

EXTERNAL 

oocooo 

0821 

ID 

J 

// 

000167 

C802S 

KNT 

I 

000263 

OeOfiM 

0822M 

0 

CD 

PTIT 

J 

// 

000052 

0302  S 

0813M 

R 

I 

// 

000177 

C8  02S 

RDAT 

I 

// 

000253 

0802S 

0813H 

0625 

REV 

I 

// 

000252 

0802S 

0813H 

081A 

RPT 

J 

n 

000130 

0S02S 

SYS 

J 

n 

0001*3 

0302  S 

0813H 

TIT 

J 

// 

000000 

0802S 

0813M 

VEH 

I 

// 

000171 

CS02S 

0813M 

UA 

I 

// 

000256 

C8G2S 

UAN 

I 

// 

000151 

0802S 

0813H 

_100 

000065 

0815D 

0816 

0818 

0825 

110 

0001A3 

0815 

0817D 

Il20 

000152 

0817 

0819D 

Il30 

000161 

0815 

0821D 

0826 

_150 

000165 

C81A 

032AD 

_160 

00017A 

032A 

08260 

170 

000203 

0826 

C828D 

“20 

000010 

'08C5D 

0811 

200 

000213 

0813 

08310 

000015 

0809 

08100 

_22 

000060 

coil 

0812C 

250 

000225 

0331 

08320 
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0816  0817  0818  , 0819 

0826  0827  0828  0829 


0818  0820 


0827  0829 


0820  0823  0825  0827 


0830 
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(0835) 
(0836)  C 
(0836)  C 
(0836)  C 
(0836) 
(0836) 
(0836)  C 
(0836)  C 
(0836)  C 
(0836)  C 
(0836) 
(0836: 
(0836) 
(0836)  C 
(0837)  C 
■ (0838)  C 
(0839)  C 
^1  (08A0)  C 

(08A1) 
(0842) 
(08A3)  3 

(08AA)  1 

(08A5) 
(08A6)  2 

(08A7)  100 

(03.48) 
(0849) 
(0850)  150 

(0851) 
(0852)  175 

(0853) 
(0854) 
(0855) 
(0856)  200 

(0857)  250 

(0858) 
(0859) 


SUBROUTINE  SYSDR 

COMMON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT*PTIT,DIR,RPT,DT»SYS*WAN,CONfID*VEH»ACT»R 
COMMON  COMP , REV, RDAT ,WA 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

INTEGER*4  TIT(21),PTIT(19),DIR(4),RPT(4),SYS(3) , CON ( 5) t ID , ACT 
INTEGER«4  C0MP(21) 

INTEGER*2  DT ( 3 ) , W AN ( 4 ) , VEH ( 2 , 2 ) , R ,RE V, RDAT ( 3 ) , U A ( 4 ) 


THIS  ROUTINE  LOCATES  ALL  DOCUMENTS  WITH  A SPCIFIED  SYSTEM 

INTEGER*4  DS,KNT 
KNT  = 0 

WRITE(1,1> 

FORMAT!*  WHAT  IS  THE  DESIRED  SYSTEM*) 

READ(1,2,ERR=3)DS 

F0RMAT(3A4) 

READ(6, END=200 ) TIT, PTIT,DIR,DT, SYS, WAN, VEH, REV, RDAT 
DO  150  1=1,3 

IF(DS.EO.SYS(I) ) GO  TO  175 

CONTINUE 

GO  TO  100 

CONTINUE  • 

CALL  FMAIN 
KNT=KNT+1 
GO  TO  100 

WRITE(1,250)KNT,DS 

FORMAT!*  THERE  ARE  *19*  DOCUMENTS  WITH  A SYSTEM  OF  *3A4) 

RETURN 

END 


) 


) 
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ACT 

J 

// 

000175 

0836S 

COMP 

J 

n 

000200 

0836S 

CON 

<J 

N 

000155  • 

0836S 

DIR 

J 

// 

000120 

0836S 

0867M 

DS 

J 

000217 

OS'HS 

0865H 

0 86  9 

0856 

DT  . 

I 

// 

OOOHO 

0S36S 

0867H 

FMAIN 

R 

EXTERNAL 

OOOOOO 

0853 

I 

I 

000221 

oe«ieM 

0869 

10 

J 

// 

000167 

C836S 

KNT 

J 

000222 

03<tl  S 

0862K 

0856H 

0856 

PTIT 

‘ J 

// 

000052 

09  36S 

0867F, 

R , 

I 

// 

000177 

033  6$. 

RDAT 

I 

// 

000253 

0336  $ 

0867M 

REV 

I 

// 

000252 

0836$ 

0867H 

RPT 

J 

// 

000130 

0836$ 

SYS 

J 

// 

000  H3 

0836$ 

0867M 

0869 

SYSDR 

R 

OOOOOO 

C835S 

TIT 

J 

// 

OOOOOO 

C 8 3 6 S 

0367M 

VEH 

I 

// 

000171 

0836S 

0867M 

VIA 

I 

// 

000256 

0836S 

WAN 

I 

// 

000151 

C336S 

0867M 

_1 

000013 

0863 

08660 

_100 

000051 

08670 

0851 

0855 

150 

000131 

0863 

08500 

I175 

OOOIAO 

0369 

C852D 

_2 

C000«5 

0865 

08660 

2 00 

000151 

0867 

08560 

_250 

000163 

0356 

08570 

_3 

000006 

0863D 

0865 

0000  ERRORS  C<SYSOR  >FTN-R EV lA . 2 3 


C-74 


SUBROUTINE  CONN 


PAGE  0072 


(0860) 
(0861) 
(0861) 
(0861) 
(0861) 
(0861) 
(0861) 
(0861) 
:0861) 
(0861) 
(0861) 
(0861) 
(0861) 
(0861) 
(0862) 
(0862) 
(0863) 
.(086A) 
(086S) 
(0866) 
(0867) 
(0868) 
(0869) 
(0870) 
(0371) 
(0872) 
(0871) 
(0874) 
(0875) 
( 0876) 
(0877) 
(0878) 
(0879) 
(0860) 
(0881) 
(0882) 
(0883) 
(0884) 


SUBROUTINE  CONN 
C 

C COMMON  BLOCK  FOR  THE  DIR  FILE 

C 

COMMON  TIT,PTIT,DIR,RPT,DT,SYS,WANf CON.ID* VEH»ACT»R 
COMMON  COMP*REV,RDATfWA 
C 
C 

C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

C 

INTEGER*4  TIT(21) ,PTIT(19) »DIR (4) ,RPT(4)iSYS(3)»C0N(5) *IO»ACT 
INTEGER*4  COMP  (21  ) 

INTEGER*2  D T ( 3 ) , W AN ( 4 ) , VEH ( 2 * 2 ) t R » RE V t R DAT ( 3 ) , W A ( 4 ) 

C 

C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY»  1977 

NOLIST 

C . 

C , 

C THIS  ROUTINE  LOCATES  ALL  DOCUMENTS  WITH  A SPECIFIED  CONTRACT  NUMBER 

C 

1NTEGER*4  DC(5),KNT 
INTEGER*2  IT,IC 
KNT  = 0 

1 WRITE(1.3) 

3 FORMAT!*  WHAT  IS  THE  DESIRED  CONTRACT  NUMBER**/) 

READ(1*2.ERR=1)DC 

2 F0RMAT(5A4) 

CALL  SRCHt$(KSRDWR  + KJNDAM»*CTAB  * 1 6 * 14 » I T . I C ) 

30  REAO(18»40,END=200)WA«CON 

40  F0RHAT(5X»4A2t2X»5A4)  . ■ 

DO  45  1=1 ,5 

IFtCON(  I)  .NE.DCd  ) ) GOTO  30 
45  CONTINUE 

100  REAO(6*END=90)TIT,FTIT,DIR*DT»SYS»WAN*VEH,REV*r6aT 

IF(WA(1).EC.*3B*.AND.WA(2).EG.*C4*.OR.WA(2).EQ.*09*)GOTO  660 

IF(WANd)  .NE.WAd  ) ) GOTO  ICO 

IF(WAN(2) .NE.WA(2>)  GOTO  100 

GO  TO  701  • 
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(08851 

660 

DO  665  1=1, A 

(0886) 

IF(UAN(  I)  .HE.WAd  ) ) GOTO  100 

(0887) 

665 

CONTINUE 

(0888) 

701 

CALL  CHAIN 

(0889) 

KNT=KNT+1 

(0890) 

GO  TO  100 

(0891) 

90 

REWIND  6 

(0892) 

GO  TO  30 

(0893) 

200 

URITE(1,250)KNT,DC 

(089A  ) 

250 

FORHAT(»  THERE  ARE*I9‘  DOCUMENTS  WITH 

(0895) 

1 • NUMBER  OF  »5AA) 

(0896) 

CALL  SRCHIi(K$CLOS, *CTAB  *, 6,0, 0,0) 

(0897) 

RETURN 

(0898) 

END 

CONTRACT 
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ACT 

U 

//  000175 

0861S 

CMAIN 

R 

EXTERNAL  000000 

088R 

COUP 

J 

//  000200 

0861S 

CON 

J 

//  C00155 

0861  S 

0875M 

0878 

CONN 

R 

000000 

0860S 

DC 

J 

000002 

C367S 

0872M 

0878 

0893 

DIR 

J 

//  000120 

0861S 

08P0M 

DT 

I 

//  OCOIAO 

0861S 

0 8 3 0 M 

I 

I 

00DA05 

C877M 

0878 

OSBbM 

0886 

!C 

I 

OCO'lO  7 

0868S 

087^16 

ID 

J 

//  000167 

0361S 

IT 

I 

OOOAIO 

0B6PS 

Ce7AA 

KSALLD 

I 

PARAMETER 

08  62$ 

KSCACC 

I 

PARAMETER 

08623 

KSCLOS 

I 

PARAMETER 

G362S 

0896 

KICONV 

I 

Parameter 

08b2S 

KSCURR 

I 

PARAMETER 

P362S 

KSDELE 

I 

PARAMETER 

08623 

K.SOMPB 

I 

PARAMETER 

0362S- 

KSDTIM 

I 

PARAMETER 

0852S 

KSENTR 

I 

000000 

0S62S 

KSEXST 

I 

PARAMETER 

0862S 

KSGOND 

I 

PARAMETER 

08  6 2 3 

KSGPOS 

I 

PARAMETER 

08623 

KSHOKE 

I 

PARAMETER 

03623 

KSICUR 

I 

PARAMETER 

0862S 

KI IMFD 

I 

PARAMETER 

08523 

KSIRTN 

I 

PARAMETER 

CS62S 

KSISEG 

I 

PARAMETER 

0 5 6 2 S 

KSI'JFD 

I 

PARAMETER 

. C862S 

KSHENT 

I 

000000 

0862S 

KSMSIZ 

1 

PARAMETER 

0362S 

KSF'VNT 

1 

PARAMETER 

CP62S 

KSNDAH 

I 

PARAMETER 

08623 

0874 

KINRTN 

I 

PARAMETER 

0 8 6 2 3 

KSNSAH 

I 

PARAMETER 

C862S 

KSNSGD 

I 

PARAMETER 

0862S 

KSNSGS 

I 

PARAMETER 

C862S 
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KSPOSA 

I 

parameter 

0862S 

KSPOSN 

1 

PARAMETER 

0962E 

KSPOSR 

I 

PARAMETER 

0862S 

KSPREA 

I 

PARAMETER 

0B6PS 

KiPRER 

I 

PARAMETER 

C852S 

KSPROT 

I 

PARAMETER 

C86"S 

KSROUR 

I 

PARAMETER 

0862S 

0874 

KSREAD 

I 

PARAMETER 

036PS 

KIRPOS 

I 

PARAMETER 

. C362S 

KSRSUB 

I 

PARAMETER 

0E62S 

KSR JLK 

I 

PARAMETER 

C862S 

KSSENT 

I 

000000 

C862S 

KSSETC 

I 

PARAMETER 

0362S 

KSSETH 

I 

PARAMETER 

CB62S 

KiSPOS 

I 

P ARAMETER 

C362S 

KSSRTN 

▼ 

i 

PARAMETER 

03625 

KSTRNC 

I 

PARAMETER 

08628 

KSUPOS 

I 

PARAMETER 

0S62S 

KSURIT 

I 

PARAMETER 

0362S 

KNT 

J 

000411 

0667S 

0869M 

0889H 

0893  , 

PTIT 

J 

//  000052 

0661S 

0880K 

R 

I 

//  000177 

0361S 

RDAT 

T 

//  000253 

036iS 

0880M 

REV 

I 

//  000252 

0361S 

0830M 

RPT 

■J 

//  CC013Q 

C 6 6 1 S 

SRCHSS 

R 

EXTERNAL  000000 

0374 

0896 

SYS 

J 

//  000143 

0361S 

0630M 

TIT 

J 

//  000000 

0861S 

0880n 

VEH 

I 

//  000171 

0361S 

0 8 3 0 M 

UA 

I 

//  000256 

0861S 

0875M. 

0881 

0882 

0>883 

UAN 

I 

//  000151 

0361S 

088  OM 

0382 

0883 

0886 

000021 

0P70O 

0372 

_100 

000161 

OSSOD 

0882 

0883 

0886 

0890 

_2 

000065 

0872 

08730 

I2OO 

CC0320 

08  75 

OB^SD 

250  ■ 

000332 

0393 

03940 

“3 

000026 

0870 

08710 

0886 
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-30 

000101 

0375D 

0378  0892 

4 0 

000116 

0875 

08760 

_45 

000152 

0377 

03790 

. 660 

000264 

0881 

08850 

~665 

000275 

0885 

08870 

I?  01 

000304 

0884 

08880 

_9C 

000315 

0380 

08910 
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>> 


-c 


(0899) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0900) 
(0901) 
(0902) 
(0903) 
(0904) 
(0905) 
(0906) 
( 0 90  7 ) 
(0908) 
(0909.) 
(0910) 
'(  0911 ) 
(0912) 
(0913) 
(0914) 
(0915) 
(0916) 
(0917) 
(0918) 
(0919) 
(0920) 
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SUBROUTINE  DIRN 
C 

C COMMON  BLOCK  FOP.  THE  DIR  FILE 

C 

COMMON  TIT,PTITtOIk,RPT,DT»SYS»WAN,CON,ID» VEHtACTfR 
COMMON  C0MP*REV,RDAT,WA 
C 
c 

C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

C 

INTEGER*4  TI  T ( 2 1 ) , P TI T ( 1 9 ) , D I R ( 4 ) , RPT ( 4 ) , S YS ( 3 ) . CON ( 5 ) » ID  * ACT 
INTEGER*4  CCMP(21) 

INTEGER»2  DT ( 3 ) »W AN < 4 ) ♦ VEH ( 2 »2 ) » R » RE V, RD AT ( 3 ) * U A ( 4 ) 

C 

C 

C 

C THIS  ROUTINE  LOCATES  A DOCUMENT  WITH  A SPECIFIED 

C DIR-REPORT  NUMBER 

C 

INTEGER*4  KNT,IDIR(4) 

KNT  = 0 

3 WRITEdtl) 

1 FORMAT!  • WHAT  IS  THE  DESIRED  DIR-REPORT  NUMBER*/) 
READ(1,2.ERR=3)  IDIR 

2 F0RMAT(3A4,A2) 

WRITE(lf2)  IDIR 

100  READ(6,END=200)TIT»PTIT,DIRtOT»S YS«WANfVEH,REV*RDAT 
DO  1000  1=1.4 

IF( IDIR (I  ) .NE.DIR (I ) ) GO  TO  100 
1000  CONTINUE 

CALL  FMAIN 
GO  TO  100 
200  RETURN 

END 
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ACT 

J 

// 

000175 

090DS 

COMP 

J 

// 

000200 

0900S 

COW 

J 

II 

000155 

C900S 

DIR 

J 

n 

000120 

09O0S 

0913H 

0915 

OIRN 

R 

OOOOOC 

0399S 

DT 

1 

// 

ODOIAO 

0900S 

0913K 

FKAIN 

R 

EXTERNAL 

000000 

0917 

I 

I 

000176 

0 V 1 4 !1 

0915 

ID 

J 

// 

000167 

C900S 

IDIR 

J 

000002 

0906S 

0910M 

0912 

KNT 

J 

000200 

0906S 

0907M 

PTIT 

J 

// 

000052 

0300S 

0 9131 

R 

I 

// 

000177 

0900S 

ROAT 

I 

// 

000253 

090CS 

09131 

REV 

I 

// 

00025? 

0900  S 

0 9 1 3 M 

RPT 

J 

// 

000130 

09COS 

I 

D 

SYS 

J 

// 

000 1R3 

0 9 0 0 S 

0913M 

TIT 

J 

// 

000000 

0900S 

0913M 

VEH 

I 

// 

000171 

090CS 

0 9 1 3 H 

UA 

I 

// 

000256 

0900S 

UAN 

I 

n 

000151 

0900  S 

0913M 

1 

00002A 

.090? 

0909D 

100 

000100 

0913D 

0915 

0918 

1000 

C00163 

0914 

0916D 

_2 

000064 

0910 

0911D 

0912 

200 

000174 

0913 

0919D 

~3 

000017 

09C3D 

0910 

0915 
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(0921)  SUBROUTINE  GETCON 

(0922)  C 

(0922)  C COKMON  BLOCK  FOR  THE  DIR  FILE 

(0922)  C 

(0922)  COMMON  TI T , PT I T ♦ 0 1 R , RPT, DT , S YS , W AN *CON * ID t VEH * ACT t R 

(0922)  COMMON  COMP i R E V ,R D A T , UA 

(0922)  C 
(0922)  C 

(0922)  C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(0922)  C 

(0922)  INTEGER*^  TI T ( 2 1 > » PT I T ( 19 ) . DIR ( A ) ♦ RPT ( A ) , S YS ( 3 ) « CON ( 5) t ID » ACT 

(0922)  INTEGER*A  C0MP(21> 

(0922)  INTEGER*2  DT ( 3 ) ,U AN < A ) , VEH ( 2 ,2 ) , R » RE V » RD AT ( 3 ) « W A ( A ) 

(0922)  C • 

(0923)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY»  1977 

(0923)  NOLIST 

(092A)  INTEGER*2  IT,IC 

(0925)  CALL  SRCH $S ( K$R DUR +K SNDAM , • CT AB  * ,6 , 1 A t I T » I C) 

(0926)  REWIND  IB 

(0927)  650  READ(18,655»END=690)UAfCON 

(0928)  655  F0RHAT(5X»AA2,rx,5AA) 

(0929)  IF ( WAN (1 ) .EC. *33* . AND.UAN(2) .EQ. »02*)  GOTO  670 

(0930)  IF(UAN( 1) .EO. *38* .AND.WAN (2) .E'J.*0A* .OR.UAN(2) .EQ.* 09* ) GOTO  660 

^ (0931)  IF(UAN( 1) .NE. WA <1 ) ) GOTO  650 

(0932)  IF(UAN< 2) .NE.UA(2) ) GOTO  650 

(0933)  GO  TO  800 

(093A)  660  DO  665  I = liA 

(0935)  IF  (UAN(I) .NE.UA (I ) ) GOTO  650 

(0936)  665  CONTINUE 

(0937)  GO  TO  800 

(0938)  670  IF<UAN(1> .NE.WAd ) ) GOTO  650 

(0939)  IF(WAN(2) .NE.WA(2) ) GOTO  650 

(D9A0>  IF(WAN(3) .NE .»AB* .AND.WAN (3) .NE.'BA* ) GO  TO  800 

(09A1)  IF(WAN(3) .EQ. *AB* .AND.WA (3) .E0.*A  ♦)  GOTO  800 

(09A2)  IF(WAN(3) .EG. *BA* .AND.WA (3) .EQ . *D  *)  GOTO  800 

(09A3)  GO  TO  650 

(09AA)  .690  CON(l)=*WA  N* 

(09A5)  C0N(2)=*0T  F* 
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(0946) 

(0997) 

(0948) 

(0949) 

(0950) 

(0951) 
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C0M(3)=*0UND» 

C0N(4)=*  SEE* 

C0N(5)=*  RJK* 

800  CALL  SRCH$$(K$CLOS»*CTAB  *»6i0*0»0) 
RETURN 
END 


) 


) 
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ACT 

J 

ft  000175 

09225 

COMP 

J 

//  000200 

0922S 

CON 

J 

//  000155 

0922S 

0927M  09AAM  09A5H  09A6H  09A7M  09A8H 

DIR 

J 

//  O0C120 

0922S 

OT 

I 

//  OOOIAC 

0922S 

GETCON 

R 

000000 

0921S 

I 

I 

000256 

093AM 

0935 

IC 

I 

000261 

092A5 

0925A 

ID 

J 

//  000167 

0922S 

IT 

I 

000262 

092A6 

0925A 

KSALLO 

I 

PARAMETER 

0923S 

KSCACC 

I 

PARAMETER 

09235 

KSCLOS 

I 

PARAMETER 

0 9 23  5 

09AO 

KSCONV 

I 

PARAMETER 

09233 

KSCURR 

I 

PARAMETER 

C923S 

KSDELE 

I 

parameter 

09235 

KSDMPB 

1 

parameter 

0923S 

KSDTIM 

I 

PARAMETER 

C923S 

KSENTR 

I 

000000 

0923S 

KSEXST 

I 

PARAMETER 

0923S 

KSGOND 

I 

PARAMETER 

C923S 

KSGPOS 

I 

PARAMF.TER 

09235 

KSHOME 

I 

PARAMETER 

09235 

KSICUR 

I 

PARAMETER 

09  23S 

KSIMFD 

I 

PARAMETER 

09235 

KSIRTN 

I 

PARAMETER 

09235 

k'siseg 

I 

PARAMETER 

0923S 

KSIUFO 

I 

parameter 

0923S 

KSMENT 

I 

000000 

09235 

KSHSIZ 

I 

parameter 

0923S 

f 

KSMVNT 

I 

PARAMETER 

09235 

KSNDAH 

I 

PARAMETER 

0923S 

0925 

KSNRTN 

I 

PARAMETER 

0923S 

KSNSAM 

I 

PARAMETER 

0323.5  . 

KSNSGD 

T 

PARAMETER 

0923S 

KSNSGS 

I 

PARAMETER 

09235 

KSPOSA 

I 

PARAMETER 

09235 

KSPOSN 

I 

PARAMETER 

09235 
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o 
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KSPOSR 

I 

PARAMETER 

0923S 

kspreA 

I 

parameter 

C923S 

KSPRER 

I 

PARAMETER 

0923S 

KSPROT 

I 

PARAMETER 

0923S 

KSROWR 

I 

PARAMETER 

0923G 

0925 

KSREAO 

I 

PARAMETER 

0923S 

KSRPOS 

I 

PARAMETER 

0923S 

KSRSUB 

I 

PARAMETER 

0923S 

KSRULK 

I 

parameter 

0923S 

KSSENT 

I 

000000 

09  2 3S 

KSSETC 

I 

parameter 

09  23? 

KSSETH 

I 

PARAMETER 

0923S 

KSSPOS 

I 

PARAMETER 

09235 

KSSRTN 

I 

PARAMETER 

09  23S 

KSTRNC 

I 

PARAMETER 

C923S 

KSUPOS 

I 

PARAMETER 

0923S 

Ki'JRIT 

1 

parameter 

C923S 

PTIT 

J 

//  000052 

0922S 

R 

I 

//  000177 

092PS 

RDAT 

I 

//  000253 

0922  S 

REV 

I 

//  00C252 

0922S 

RPT 

J 

//  000130 

0922S 

SRCH$$ 

R 

EXTERNAL  000000 

0525 

0949 

SYS 

J 

//  000143 

0922S 

TIT 

J 

//  000000 

0922S 

VEH 

I 

//  000171 

0922S 

U.A 

I 

//  000256 

0922S 

0927M 

0941 

0942 

UAN 

I 

//  000151 

0922S 

0929 

0939 

0940 

650 

000014 

0927D 

0931 

^655 

000030 

0927 

C92SD 

_660 

000117 

0930 

0934D 

665 

000131 

.0534 

09360 

~670 

000140 

0929  • 

0938D 

^690 

000217 

0927 

09440 

~8  0 0 

C00245 

0535 

0937 

0931 

0932 

0935 

0930 

0931 

0932 

0941 

0942 

0932 

0935 

0938 

09'tO 


og-a  0942 
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00 
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!0952) 

!0953) 

C 

!0953> 

C 

!0953) 

C 

!0953) 

!0953) 

!0953) 

C 

!0953) 

C 

!0953) 

C 

!0953) 

C 

!Q953) 

!0953) 

!0953) 

!0953) 

C 

!0954) 

C 

!0955) 

C 

D 

1 

!0956) 

c 

» 

!0957> 

c 

!C958) 

!0959) 

998 

r 

!0960) 

999 

!0961) 

!0962) 

103 

!0963) 

!096A) 

101 

!0965) 

!0966) 

!0967) 

102 

!0968) 
!0969) 
!0970  ) 
!0971) 

150 

!0972) 

!0973> 

201 

!097A) 

202 

!0975) 

!0976) 

!0977) 

AOO 

subroutine  FMAIN 

COMMON  BLOCK  FOR  THE  DIR  FILE 

COMMON  TIT»PTITfOIRiRPT»DT*SYS*WAN»CON»IDtVEH»ACT »R 
COMMON  COMP, REV, SDAT,WA 


DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

INTEGER*^  TIT(21),PTIT(19),DIR<a>,RPT(A).,SYS(3),C0N(5),ID,ACT 

INTEGER*^  C0MP(21) 

INTEGER*2  DT(3),UAN(A),VEH{2,2),R,REV,RDAT(3),UA(A) 


THIS  IS  THE  BASIC  OUTPUT  ROUTINE  FOR  THE  SPOOLER  AND  TERMINAL 

WRITE(1,998) 

FORHATC//) 

FORMAT(IHO) 

URITE(7,999) 

URITE(1,101) 

WRITE(7,101> 

FORMATC  • (1)  TITLE  */) 

URITE<1,102)PTIT 

WRITE(7,102)PTIT 

F0RKAT(1X,19AA) 

IFCREV.NE.’  *)  GOTO  201 
URITE  ( 1,150)DIP.  ,REV 
WRITL(7,150) DIR,REV 

FORMAT!*  (2)  DIR/REPORT  NUMBER  (P)  REVISI ON • , / , 1 X, 3 A A , A2 , 9X , 1 A27 ) 
GO  TO  AOO  , • 

URITE(1,2C2)DIR,REV 

FORMAT!*  !2)  DIR/REPORT  NUMBER  !F)  REV  I SI CN * , / , 1 X, 3 A A , A2 , 9X  , 

1 *RCV  *,1A2/) 

URITE!7,202)DIR,REV 

URITE!7,A02)DT,RDAT 


) 


OOBA  ~ 


) 
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<0978) 

UP.ltE(lt302)DT,RDAT 

(0979) 

302 

F0RMAT(»  (3)  DOCUMENT  D ATE ’ < 6X » » < 9 ) REVISION  0 ATE  * * / » 1 X»2 ( IP « * 

(0980) 

1 I2.15X,2(I2t*-*),I2/) 

(0981) 

501 

URITE(1»502)SYS 

(0932) 

URITE(7,5C2)SYS 

(0983) 

502 

FORHATC  (3)  SYSTEM  * t /3  < 1 Xt  A3 )/ ) 

(098A) 

601 

URITE(1*602)WAN 

(0V85) 

URITE(7,602)UAN 

(0^86) 

602 

FORMAT!*  (5)  U.A.  NUMEER/ID  CODE  * » / IX, 3 A2/ ) 

(0  >8  7) 

CALL  GETCON 

( ors) 

701 

URITE! 1,7C2)C0N 

(0939) 

URITE(7,702)CON 

(0990) 

702 

FORMAT!*  (6)  CONTRACT  NUMBER  * , / , 1 X , 5 A3 / ) 

(0991) 

901 

URITE(1,9Q2) ( ( VEH( I , J) » J=l,2) ,1=1,2) 

(0992) 

URITE(7,902) ( (VEH( 1 ,J) ,J  = 1,2)  ,1  = 1,2) 

(0993) 

902 

FORMAT!*  (7)  VEHI CLE * ,/ , 1 X, 1 3, A 1 , 1 X , 1 3, A 1/ ) 

(0993) 

CALL  RECYCL 

(0995) 

CALL  PAUS 

(0996) 

RETURN 

(0997) 

END  . 

Oh 
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ACT 

J 

// 

000175 

0953S 

C.1HP 

J 

n 

000200 

0953S 

CON 

J 

// 

000155 

0953  S 

0988 

0989 

DiR 

J 

// 

000120 

0953$ 

0969 

0970 

0973 

0976 

DT 

I 

// 

OOOIAO 

0953$ 

0977 

0978 

FHAIiJ 

R 

000000 

0952S 

GETCON 

R 

external 

000000 

098  7 

I 

I 

• 

000632 

0 9 9 1 N 

0992K 

ID 

J 

// 

000167 

0953S 

J 

I 

000633 

0991  “ 

0 9 9 2 

PAUS  ■ 

R 

external 

000000 

0995 

PTIT 

J 

// 

000052 

0953S 

0965 

0966 

R 

I 

// 

000177 

0953S 

RDAT 

I 

// 

000253 

0953S 

0977 

0978 

RZCYCL 

R 

EXTERNAL 

000000 

0994 

REV 

I 

// 

000252 

C953S 

0968 

0969 

0970 

0973 

0976 

RPT 

d 

// 

000130 

0953S 

svs 

d 

// 

000143 

0953S 

0981 

0962 

TIT 

d 

// 

000000 

0953S 

VZH 

I 

// 

000171 

0953S 

0991 

0992 

UA 

I 

// 

000256 

0953S 

WAN 

1 

// 

000151 

0953S 

0984 

0985 

_101 

0CC032 

0962 

0963 

0964D 

102 

OOOC61 

0965 

0966 

0967D 

Ii03 

000022 

0962D 

~150 

■ ' 

000121 

0969 

0970 

09710 

I*?  01 

000161 

0968 

0973D 

.202 

000173 

0973 

C974D 

0976 

400 

000250 

0 9 72 

0977D 

*402 

000274 

0977 

0978 

09790 

3ii 

000346 

09810 

502 

000364 ■ 

0981 

0982 

09830 

“6C1 

000402 

0984D 

602 

000422 

0984 

0985 

09860 

701 

000447 

C988D 

_702 

000465 

0988 

0989 

09900 

~901 

000507 

0991D 
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902 

030601 

0991 

0992 

_998 

OCOOC6 

0958 

C959D 

“■999 

000011 

0960D 

0961 

OOCO  ERRORS  C<FMAIN  >FT N -R EVl 4. 2 3 


0 

1 

00 
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(05'’8) 

SUBROUTINE  CHAIN 

(09C9) 

C 

(09V9) 

C 

COHHON  BLOCK  FOR  THE  DIR  FILE 

<0999) 

C 

(0999) 

COHHON  TIT»PTITiDIR»RPTf DTtSYStWANtCON, IOfVEH»ACT  *R 

(0999) 

COHHON  COMP. REV, RDATtUA 

(0999) 

C 

(0999) 

C 

(0999) 

C 

DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(09-;9) 

C 

(0999) 

INTEGER*^  TIT(21),PTIT(19).DIR(A),RPT(A),SYS(3)»C0N(5).ID.ACT 

(C9?9) 

INTEGER*^  C0MP(21) 

(0999) 

INTEGER*?  DT(3) »WAN(A) .VEH(2.2> .R.REV.RDAK 3) ,UA(A) 

(0  999) 

C 

• 

( 1 0 0 0 ) 

C 

(1001) 

c 

(lot?) 

c 

THIS  IS  THE  BASIC  OUTPUT  ROUTINE  FOR  THE  SPOOLER  AND  TERMINAL 

(1003) 

c 

(lOOA) 

URITE(1,998) 

(1905) 

998 

FORMAT!//) 

(1006) 

999 

FORHAT(IHO) 

(1007) 

URITE(7,999) 

(1008) 

103 

WRITE(l.lOl) 

(10J9) 

URITE(7.101) 

(1310) 

101 

FORMAT!*  (1)  TITLE  •/) 

(1011) 

WRITE(1,102)PTIT 

(10’ 2) 

URITE(7,102)PTIT 

(H13) 

102 

FORMAT! IX , 19AA) 

(1! lA) 

IF(REV.NE.*  •)  GOTO  201 

(1015) 

URITE(1,150)DIR,REV 

(10i6) 

WRITE(7,150)DIP,.REV 

(10i7) 

150 

FORMAT!*  (2)  D.IR/REPORT  NUMBER  (8)  RE  VI  SI  ON  * , / , 1 X,  3A  A . A2 , 9X  . 1 A2  / ) 

(1013) 

GO  TO  AOO  • 

(1019) 

201 

URITE(1,202)DIR.REV 

(1020 

202 

FORMAT!*  (2)  DIR/REPORT-  NUMBER  (8)  RE V ISI ON ♦ . / . 1 X , 3 AA , A2 . 9X , 

(1021 ) 

1 *REV  *,1A2/) 

(1022) 

WRITE (7,202)DIR,REV 

(1023) 

AOO 

URITE(7,A02)DT,RDAT 
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<1 J2A) 

UR1TE(1»402)0T,RDAT 

(1125) 

402 

FORHAT(*  (3)  DOCUMENT  DAT E* ♦ 6X, • ( 9)  REVISION 

(1C2£) 

1 I2«15X*2(I2»*-*),I2/) 

(1027) 

501 

yRITE(l,502)SYS 

(1018) 

WRITE(7*502)SYS 

(1029) 

502 

FORKAT(*  (4)  SYSTEM*, /3(1X*A4)/) 

(1030) 

601 

URITE(1,602)UAN 

(1031) 

WRITE(7,602)WAN 

(1032) 

602 

FORMATC  (5)  U.A.  NUHDER/ID  CODE  • , /I  X , 4 A 2 / ) 

(1033) 

701 

URITE(1,702)C0N 

(1034) 

WRITE(7,702)CON 

(1035) 

702 

FORHAT(*  (6)  CONTRACT  NUMBER  * , /I  X , 5 A 4/ ) 

(1036) 

901 

WRITE(1,902)((VEH(I,J),J=1,2),1=1,2) 

(1037) 

WRITE(7,902M(VEH(I,d),J  = l,2),I  = l,2) 

(1038) 

902 

FORMAT(*  (7)  VEHICLE*,/, IX, 13, Al, IX, 13, Al/) 

(lo39) 

CALL  RECYCL 

(1040) 

CALL  PAUS 

(1041) 

RETURN 

(1042) 

END 

DATE»»/tlX*2< la, •-•) » 
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a:t 

J 

// 

000175 

0999S 

C IAIN 

R 

OGCOOO 

0996  S 

CO  HP 

J 

// 

000200 

0999S 

CON 

J 

// 

000155 

0999S 

1033 

1034 

DIR 

J 

// 

000120 

0999S 

1015 

1016 

1019 

1022 

DT 

I 

// 

OCO140 

0999S 

1023 

1024 

I 

I 

000631 

10  36M 

1037H 

ID 

J 

// 

000167 

0999S 

J 

I 

000  632 

1036M 

1037H 

PAUS 

R 

EXTERNAL 

000000 

1040 

PTIT 

.) 

// 

000052 

0999S 

1011 

1012 

R 

I 

// 

000177 

0 9 9 9 S 

RDAT 

I 

// 

000253 

. 0999S 

1023 

1024 

RECYCL 

R 

EXTERNAL 

000000 

1039 

REV 

■ I 

// 

000252 

0959S 

1014 

1015 

1016 

1019 

RPT 

J 

// 

000150 

0999S 

SYS 

J 

// 

000143 

0999S 

1027 

1028 

TIT 

J 

// 

COOOOD 

09  99S 

VEH 

I 

// 

000171 

0999S 

1036 

1037 

UA 

I 

// 

000236 

0955S 

WAN 

I 

// 

000151 

0999S 

1030 

1031 

_101 

000032 

loce 

1009 

10100 

102 

000061 

1011 

1012 

10130 

_103 

000022 

1005C 

150 

000121 

1015 

1016 

10170 

_2  01 

000161 

1014 

1019D 

~2  02 

000173 

1019 

10200 

1022 

Iaco 

000250 

lOlfi 

10230 

_4C2 

000274 

1023 

1024 

10250 
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Isoi 

000346 

1027D 

502 

000364 

1027 

102ft 

10290 

_601 

000402 

1 0 3 0 D 

602 

000422 

1030 

1031 

10320 

~701 

000446 

10330 

_702 

000464 

1033 

1034 
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(10'»3)  SUBROUTINE  ARCDR 

(lOAA)  C 

(lOAA)  C COMMON  BLOCK  FOR  THE  DIR  FILE 

(10A4)  C 

(lOAA)  COMMON  TIT,PTIT,DIR»P.PT,DT,SYSfWAN,CONtID»VEH,ACTtR 

(lOA^t)  COMMON  COMP. REV, RDAT,WA 

(lOAA)  C 
(lOAA)  C 

(lOAA)  C DATA  DECLARATION  BLOCK  FOR  THE  DIR  FILE 

(10A4)  C 

<1044)  • INTEGER»4  T I T ( 2 1 ) , P T I T (1 9 ) , D I R ( * ) ♦ RP T ( 4 ) , SYS ( 3 ) , CON ( 5 ) , ID ♦ AC T 

(1044)  INTEGER*4  C0MP(21) 

(1044)  INTEGER»2  D T ( 3 ) , U AN ( 4 ) , VEH ( 2 , 2 ) , R , R E V ,R D AT ( 3 ) , U A ( 4 ) 

(10)4)  C 

(1G45>  C SYSCOM>KE YS  .F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(10^5)  NOLIST 

(lO^'B)  C 
(10‘-7)  C 

O (1048)  C ARCHIVE  ROUTINE  FOR  THE  DIR  FILE 

(1049)  C 

( 1 050)  INTEGER*4  IDR<4) 

(1051)  INTEGER*2  IT,IC 

V (1052)  C VALIDATE  THE  INCOMMING  USER 

(1053)  C 

(1054)  CALL  lOUSER(IAI) 

(1055)  IF( lAI.EQ.’SY*)  GO  TO  10  ' 

(1056)  URITE(1,300) 

(1057)  300  FORMAT( ‘GGSORRY  YOU  ARE  NOT  VALIDATED  TO  USE  THIS’, 

(1053)  IIX’ROUTINE’ ,/,  • IF  IT  IS  NEEDED  CONTACT  YOUR  SYSTEMS’, 

(1059)  IIX’  PROGRAMMER  AT  EXT  2621’/////) 

(1060)  RETURN 

(lOt.l)  10  WRITE  (1,1) 

(1062)  1 FORMAT!’  WELCOME  TO  THE  DIR-REPORT  FILE  ARCH  I VE  R OUT  I NE  ’ , / 

(1063)  1’  HOW  MANY  DOCUMENTS  DO  YOU  WISH  TO  ARCHIVE’,/) 

(1064)  READ(1,2,ERR=10)IKNT 

(1065)  2 F0RMAT(I5) 

(1066)  IF(IKNT.EO.O)  RETURN 

(1067)  CALL  SRCHil(K$RDWR+K$NOAM,’INACT  ’,6,5,IT,IC) 
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(10G8)  C 

(1069)  C PLACE  THE  ARCHIVE  FILE  AT  THE  EOF  MARKER 

(1C70)  C 

(1171)  50  REA0(9fEN0=75)TIT,PTIT,0IR»DT»SYSfUAN.VEH»REV»RDAT 

(1172)  GO  TO  50 

(1CT3)  75  DO  9999  IL00P=1,IKNT 

(107A)  82  WRITEd.eO) 

(1075)  80  FORHAT(*  WHAT  IS  THE  DIR-REPORT  NUMBER  OF  THE  DOCUMENT  •* 

(1016)  1»  YOU  WISH  TO  ARCHIVE**/) 

(1017)  READ(l*81tERR=82) IDR 

(1078)  81  F0RMAT(3AA*A2) 

(1079)  100  READ(6.ENO=200)TIT*PTIT,DIR*DT,SYS*UAN«VEH*REV*RDAT 

(1080)  DO  150  1=1, A 

(1081)  IFdORd)  .NE.DIR(I)  ) GO  TO  125 

(1082)  150  CONTINUE 

(1083)  URITE(9)TIT,PTIT,DIR,DT,SYS,WAN,VEH,REV,RDAT 

(108A)  GO  TO  100 

(1C85)  125  WRITEdO)  TIT,PTIT,DIR,DT,SYS,UAN,VEH,REV*RDAT 

(i:b6)  GO  TO  100 

^ (1C87)  200  CALL  SRCH $ $ ( K$C LOS , *0 IR  *,6, 0,0,0) 

dC/86)  CALL  SRCH$$(K$OELE,  *DIR  *,6,0, 0,0) 

(10E9)  CALL  SRCHSt(K$CLOS, *TEMP  *,6,0, 0,0) 

(109L)  CALL  CNAK.1$(*TEMP  »,6,*0IR  *,6,IC) 

(109'd  CALL  SRCH$$(K$RDWR+K$NDAH, *DIR  *,6,2,IT,IC) 

(1092)  CALL  SRCHtltKSRDWR+KlNDAM, 'TEMP  *,6,6,IT,IC) 

(1093)  9999  CONTINUE 

(1C9A)  ENDFILE  9 

(1095)  CALL  SRCHSJ(K$CLOS,*INACT  *, 6, 0,0,0) 

(1096)  RETURN 

(1097)  END 
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ACT 

J 

//  000175 

lOAAS 

ARCDR 

R 

OOOOOC 

10A3S 

CNAH$$ 

R 

EXTERNAL  000000 

1090 

CDHP 

U 

//  000200 

104AS 

CON 

J 

//  000155 

lOAAS 

DIR 

J 

//  000120 

lOAAS 

1071M 

1079M 

1081 

1083 

DT 

I 

//  OOOIAO 

lOAAS 

1 0 7 1 M 

1079H 

1083 

1085 

I 

I 

000705 

lOROM 

1081 

7AI 

I 

000707 

1C5AA 

1055 

1C 

I 

000710 

1051S 

1067A 

1090A 

1091  A 

1092A 

10 

u 

//  000167 

lOAAS 

IDR 

J 

000002 

1050S 

1077M 

1081 

IDUSER 

I 

EXTERNAL  000000 

1054 

IKNT 

I 

000711 

1064M 

1066 

1073 

ILCOP 

I 

000712 

1073M 

IT 

I 

000713 

1051  S 

1067A 

1091A 

1092A 

KIALLD 

I 

PARAMETER 

10  45S 

K4CACC 

I 

PARAMETER 

1045S 

K.CCLOS 

I 

= ARAMETER 

1045S 

1087 

1089 

1095 

KSCONV 

I 

parameter  . 

1045E 

KSCURR 

I 

PARAMETER 

1045S 

KSDELE 

I 

parameter 

1045S 

1088 

KSDMPB 

I 

PARAMETER 

1045S 

KSDTIM 

I 

PARAMETER 

1045S 

KSENTR 

I 

000000 

1045S 

KlEXST 

I 

PARAMETER 

10^55 

KSGOND 

I 

PARAMETER 

1C45S 

KJGPOS 

I 

PARAMETER 

1C45S 

;;$hOME 

I 

PARAMETER 

1045S 

tSICUR 

r 

PARAMETER 

1045S 

;<^IMFD 

I 

PARAMETER 

1045S 

KSIRTN 

I 

PARAMETER 

1045S 

KJISEG 

I 

PARAMETER 

1045S 

KSIUPD 

I 

PARAMETER 

1045S 

KSMENT 

1 

000000 

1Q45S 

KSHSIZ 

I 

PARAMETER 

1045S 

KSMVNT 

I 

PARAMETER 

1045S 

KSNDAH 

I 

PARAMETER 

1045S 

1067 

1091 

1092 

1085 
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. I 


KSNRTN 

I 

PARAMETER 

10A5S 

KSNSAH 

I 

PARAMETER 

10A5S 

KSNSGO 

I 

PARAMETER 

lOADS 

KSN3GS 

I 

PARAMETER 

1CA5S 

KSPOSA 

I 

PARAMETER 

10A5S 

KSPOSN 

I 

PARAMETER 

10A5S 

KSPCSR 

I 

PARAMETER 

10A5S 

KSPRCA 

I 

PARAMETER 

10A5S 

KSPRER 

I 

PARAMETER 

10A5S 

KSPROT 

I 

PARAMETER 

10A5S 

ksruur' 

I 

PARAMETER 

10A5S 

1067 

1091 

1092 

ksrlad 

I 

PARAMETER 

10A5S 

KSRPOS 

I 

PARAMETER 

10A5S 

KSRSUr 

I 

PARAMETER 

10A5S 

KSRULr 

I 

PARAMETER 

10A5S 

KSSENT 

I 

000000 

10A5S 

KSSETC 

I 

Parameter 

10A5S 

KSSETH 

I 

PARAMETER 

1Q45S 

KSSPOS 

I 

PARAMETER 

lO'^BS 

KSSRTN 

I 

PARAMETER 

10A5S 

KSTRNC 

I 

parameter 

10'*5S 

KSUPOS 

I 

PARAMETER 

10A5S 

KSURIT 

I 

PARAMETER 

10R5S 

PTTT 

J 

//  000052 

10  A AS 

1071H 

1079H 

1083 

1085 

R 

I 

//  : 000177 

10*AS 

ROAT 

I 

//  000253 

lOftAS 

1071M 

1079M 

1083 

1085 

REV 

I 

//  000252 

lOAAS 

1071M 

1079M 

1083 

1085 

RPT 

J 

//  000130 

10  AAS 

SRCHSS 

R 

EXTERNAL  OOOOOO 

1067 

1087 

1088 

1089 

1091 

SYS 

c' 

.//  0001A3 

lOAAS 

1 0 7 1 M 

1079H 

1083 

1085 

TIT 

U 

//  000000 

lOAAS 

1071M 

1C79H 

1083 

1085 

VEH 

I 

//  000171 

104AS 

1071M 

1079K 

1083 

1085 

UA 

1 

//  000256 

lOAAS 

UAN 

I 

//  000151 

10  AAS 

1071M 

1079H 

1083 

1085 

_1 

000137 

1061 

1062D 

10 

000133 

1055 

10610 

106A 

100 

■OOOAIO 

■ 10790 

108A 

1086 

1092  1095 
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125 

000542 

1081 

1085D 

_.'  50 

000474 

1080 

1082D 

000233 

1064 

1065D 

~?C0 

000602 

1079 

1087D 

13  00 

000027 

1056 

10570 

50 

000252 

1071D 

1072 

_75 

000314 

1971 

10730 

80 

000323 

1074 

10750 

81 

CC0403 

1077 

107HC 

l3  2 , - 

000317 

10740 

1077 

.9999 

000661 

1073 

1093D 
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APPENDIX  D 

L_FILE  FOR  DRAWING/ENGINEERING  ORDER 


D-1 


(0001) 
(0002) 
(0003) 
(00  O')) 
(0005) 
(0006) 
( 

(0308) 
(0308) 
(0008) 
(0008) 
(0008) 
(00l8) 
(00C8) 
(0008) 
(0008) 
(0003) 
(0008) 
(0008) 
(0008) 
(0008) 
(0008) 
(0308) 
(0308) 
(0)09) 
(0039) 
(0010) 
(0011) 
(0012) 
(0  0?  3) 
(0313) 
(0015) 
(0016) 
(0017) 

( 0 0 :•  8 ) 
(0U19) 
(0020) 


C 

C DRAUING-EO  FILE  FOR  NASA/SPO 

C 

C WRITTEN  BY  DANNY  K.  HARRIS  - VOUGHT  CORP. 

C FOR  THE  NASA/SPO/=RIHE  300  MINI.  COMPUTER 

C 

C 

C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

C . 

COMMON  DRAU*TIT,PTIT,DT,SYS*VEH,SECT,NSHTfFREV»FNEO»FEOREFt 
1 DRW, SHIN, REV.NEOtEOREFt 

I eon,ftit,eptit,eorev,edt,erdt,eoveh, 

1 R,  IDR,INEO,Kr.‘T, FIRST, SECOND, TTIT 

C ■ 

C DATA  DECLARATION  SLOCK  FOR  THE  DRAU-EO  FILE 

C 


INTEGER *3  DRAW(3),TIT(21),PTIT(19),SYS(3),SECT(3),FEOREF(10,2)» 

1 DRW(3>,EOREF(10,2) ,EPTIT(19) ,ETIT(21),E0N(2) • 

1 IDR(.3),kNT,TTIT(19) 

INTEGER»2  OT ( 3 ) , VEH ( 2 ,2 ) , NSHT , SHTN( 2 ) , FR EV » FNEO, RE V. NEO» 

1 E0REy,EL'T(3),ERDT(3),E0VEH(2,2)  ,R,INEO, 

1 FIRST, SECOND 

C 
C 

C SYSCOM>KEYS.F  ' MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  '31  MAY,  1977 
NOLIST 

INTEGER*2  I DES , IC , I P AS ( 3 ) 

C , ■ • 

CALL  CLEAR 


C FILES  USED 

C FILE  UNIT  FUNIT  DESCRIPTION 


TTY 

DRAW 

OUT 

REVS 


1 1 TERMINAL 

6 2 DRAW  DATA  STORAGE  SUBFILE 

7 3 OUTPUT  FILE  FOR  THE  SPOOLER 

8 3 temp  FILE  FOR  USE  IN  THE  REVISE  RUN 


c 
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(0021) 

C 

INACTD 

9 

5 

INACTIVE  DRAWING  STORAGE  FILE  - ARCHIVE  RUN 

(0022) 

c 

TEMP 

10 

6 

■ GENERAL  PURPOSE  TEMP  FILE  FOR  DRAWINGS 

(0023) 

c 

INACTS 

11 

7 

INACTIVE  SHEET  STORAGE  FILE  - ARCHIVE  RUN 

(0024) 

c 

SHEET 

12 

8 

SHEET  DATA  STORAGE  SUBFILE 

(0025) 

• C 

ETEHP 

13 

9 

GENERAL  PURPOSE  TEMP  FILE  FOR  EO'S 

(0026) 

c 

STEMP 

14 

10 

GENERAL  PURPOSE  TEMP  FILE  FOR  SHEET  DATA 

(0027  ) 

c 

INACTE 

17 

13 

INACTIVE  EO  STORAGE  FILE  - ARCHIVE.  RUN 

(0028> 

c 

EO 

18 

14 

E.O.  DATA  STORAGE  SUBFILE 

(0029)  C 
(0030)  C 

(0031)  CALL  C0HIt$(*TTY  *,6»12tIC) 

(0032)  CALL  IDENT 

(0033)  CALL  BREAK$(.TRUE. ) 

(003^1)  CALL  SRCHS$(K$RDUR  + KINDAM»*DRAU  ♦*6,2*1»IC) 

(0035)  IF(IC.NE.O)  GOTO  1000 

(0036)  CALL  SRCHIS(KJRDWR+K$NDAM,*EO  •*6*1A*1»1C) 

(0037)  IF(IC.NE.O)  GOTO  1000 

(0038)  CALL  SRCHSS(K$RDWR+K$NOAH, 'SHEET  »t6»8*l»IC) 

(0039)  IF(IC.NE.O)  GOTO  1000 

(OOAO)  URITE(1*3) 

(0041)  CALL  0REAK$(. FALSE.) 

(0042)  2 READ(1,4) IDES  • 

(0043)  REWIND  6 

(0044)  REWIND  12  - 

(0045)  REWIND  18  • 

(0046)  * F0RHAT(A2) 

(0047)  IFdDES.EQ.'IN*  ) CALL  INPTDW 

(0048)  IFdDES.EQ.  *SE»)  CALL  SEADU 

(0049)  IF(IDES.EQ..*RE')  CALL  REVSDW 

(0050)  IFdDES.EQ. 'AR')  CALL  ARCDW 

(0051  ) IFdDES.EQ. 'OU»)  GO  TO  1001 

(0052)  CALL  CLEAR 

(0053)  URITE(1»3) 

(0054)  3 FORMATC  PLEASE  CHOSE  ONE ’ OF  THE  FOLLOWI NG » « /» 

(0055)  1»  MODE  KEY'f/, 

(0056)  1*  INPUT  INP'f/f 

(0057)  1»  REVISE  REV*,/, 

(0058)  1*  SEARCH  SEA*,'/, 


c 
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~1 


(0059) 
(0060  ) 
(OGGI) 
(00G2) 
(0063) 
(0064) 
(OOGS) 
(0 )G6) 
(00 j7) 
(00G8) 
(OOf 9) 
(0070) 
(0071) 
(0072) 
(0073) 


1»  ARCHIVE  ARC**/» 

1*  QUIT  QUIT’*//) 

GO  TO  2 

1000  URITE(ltl002) 

1002  FORHAT(*DRAU  FILE  IS  IN  USE  - PLEASE  TRY  LATER*/////) 

1001  CALL  SRCHSSCKSCLOS, *DRAU  *,6*0, 0,0) 

CALL  SSCH5$(KSCL0S, »EO  *,6,0, 0,0) 

CALL  SRCHJKKSCLOS, ’SHEET  *,6,0, 0,0) 

IPAS(1)=*  * 

IPAS(2)=*  • • 

IPAS(3)=*  * 

CALL  ATCHSK •F_HAIL*,6,K$ALL0,IPAS,KtIHFD+KSSETH,IC) 
CALL  RESU$t('BFILE*,5) 

CALL  EXIT 
END 


0 

1 

oi 


c 


ARfbU 

R 

EXTERNAL  000000 

0050 

ATCHfJ 

R 

EXTERNAL  000000 

0070 

PREAKJ 

R 

EXTERNAL  000000 

0033 

0041 

CLEAR 

R 

EXTERNAL  000000 

0012 

0052 

COHISJ 

R 

EXTERNAL  000000 

0031 

DRAW 

J 

//  000000 

OOOSS 

DRU 

J 

//  0002?6 

OOOOS 

DT 

I 

//  000130 

OOOSS 

EOT 

I 

//  000A37 

0008S 

EON 

J 

//  000312 

OOOSS 

E.1REF 

J 

//  0002A2 

OOOSS 

EOREV 

I 

//  000A36 

ooces 

EOVEH 

I 

//  OOOAA5 

OOOSS 

EPVIT 

0 

//  000370 

OOOOS 

ERDY 

I 

//  000AA2 

OOOOS 

Ein 

J 

//  000316 

OOOOS 

Exn 

R 

EXTERNAL  000000 

00  72 

FEOREF 

J 

//  000156 

OOOOS 

FIRST 

I 

//  000465 

OOOOS 

>oo> 

FNEO 

I 

//  000155 

OOOSS 

FREV 

I 

//  000154 

OOOOS 

‘sj'S 

IC 

I 

000442 

OOlOS 

0031A 

0034A 

0035 

0036A 

0037 

IDENT 

I 

EXTERNAL  000000 

0039 

0032 

0070A 

IDFS 

I 

000443 

OOlOS 

0042H 

0047 

0048 

0049 

0 0.50 

IDR 

J 

//  000452 

OOOOS 

irJE  0 

I 

//  000462 

cocos 

INfTDU 

I 

external  000000 

0047 

IPA? 

I 

003002 

OOlOS 

0067M 

0068H 

0069M 

007.0A 

KSALLD 

I 

PARAMETER 

C009S 

0070 

KSCACC 

I 

PARAMETER 

0009$ 

KSCLOS 

I 

PARAMETER 

OOOOS 

0064 

0065 

0066 

KJCONV 

I 

PARAMETER 

OOOSS 

KSCURR 

I 

PARAMETER 

OOOOS 

KSDELE 

.1 

PARAMETER 

OOOOS 

KSDHPB 

i 

PARAMETER 

OOOOS 

KSOTIM 

I 

PARAMETER 

OOOOS 

KSEN  TR 

I 

000000 

, pooos 
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c 


K^EXST  I PARAMETER 
Kr.GOND  r PARAMETER 
KA6P0S  I PARAMETER 
KSHOHE  I PARAMETER 
KSIC'JR  I PARAMETER 
KSIhFD  I PARAMETER 
KSIRTiJ  I parameter 
KSISEG  I PARAMETER 
KSIUFD  I PARAMETER 
KSMENT* I 000000 

KSHSIZ  I PARAMETER 
XSMVNT  I PARAMETER 
<tNOAM  I PARAMETER 
KifjRTN  I PARAMETER 
KSNSAM  I PARAMETER 
K5NSG0  I PARAMETER 
a KlNSGS  I PARAMETER 
' KtPOSA  I PARAMETER 
KiPOSN  I PARAMETER 
KSPOSR  I PARAMETER 
KSPREA  I PARAMETER 
KSPRER  I PARAMETER 
KSPROT  I PARAMETER 
KiiRDUR  I PARAMETER 
KSREAO  I PARAMETER 
KSRPOS  I PARAMETER 
r.iRSUB  I PARAMETER 
KIRWLK  I PARAMETER 
KSSENT  . I OOOOOO 

KISETC  I PARAMETER 
KSSETH  I PARAMETER 
KISPOS  I PARAMETER 
KSERTN  I PARAMETER 
KtTRNC  I PARAMETER 
KlUPOS  I “ARAMETER 
K$WRIT  I PARAMETER 
KNT  J //  OOOA63 

NEO  1 //  C002A1 


0009S 

0009S 

0009S 

00095 

0009S 

0009S  0070 

OOC9S 

000°S 

0 0 095 

000  = 5 

0009S 

000=5 

000=15  0034 

00095 

00095 

000  = 5 

00095 

00095 

00095 

00  095 

00095 

00095 

00095 

00095  0034 

0009S 

0009S 

00095 

00095 

00095 

00095 

00095  0070 

00095 

C0C9S 

0009S 

000.95 

00C95  ■ 

ODOOS 
00  CPS 


0036 


0036 


0038 


0038 
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C 


NSHT 

I 

n 

000153 

0008S 

priT 

J 

ft 

000062 

OOOCS 

R 

I 

n 

OOOA51 

oooes 

R^SUSS 

R 

EXTERNAL 

000000  ■ 

0071 

REV 

I 

// 

0002AO 

0008S 

REVSnU 

R 

EXTERNAL 

000000 

OOA° 

SEAOW 

R 

EXTERNAL 

000000 

OOAR 

SECOND 

I 

// 

000R66 

OOOSS 

SECf 

J 

// 

0001A5 

■ OOOSS 

SHTN 

I 

// 

000236 

OOOPS 

SRCHSS 

R 

EXTERNAL 

000000 

00  3A 

0036 

0038 

006A  0065  0066 

SYS 

J 

// 

000133 

coons 

TIT 

J 

// 

000010 

ooons 

fTlT 

J 

// 

000A67 

OOOfcS 

.EH 

I 

// 

OOOlAl 

OOOSS 

1000 

000330 

0 0 35 

0037 

0039 

0062D 

“lOOl 

000365 

0051 

006AO 

_1002 

00033A 

0062 

0063D 

2 

000070 

00A2D 

0061 

3 

000152 

COAO 

0053 

0 05AD 

A 

000110 

0CA2 

0046D 
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>( 


(007A) 
(0075) 
(0076) 
(0077) 
(0078) 
(0079) 
(0060 ) 
(0083  ) 
(0081  ) 
(0382) 
(0083) 
( 008A) 
(0085) 
(0036) 
(0087) 
(0088) 
(0039) 
(0090) 
O (0  '91) 
(0U'-2) 
>0r  (0093) 

(0093) 
(0095) 
(0096) 
(0097) 
(0098) 
(0099) 
(OiOO) 
(0101) 
. (0102) 
(0103) 
(0103) 
(0105) 
(0106) 
(0107) 
(0108) 
(0109) 
(Oil-:) 


SUBROUTINE  IDENT 
C 

C THIS  ROUTINE  KEEPS  TRACK  OF  WHO  ACCESSED  THE  CALLING 

C PROGRAM  LAST 

C 

INTEGER*2  ARRAY(15) 

C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

NOLIST 

CALL  BREAKK  .TRUE.  ) 

CALL  TIM0AT(ARRAY,15) 

C 

C OPEN  TEMP  FILE  (FUNIT  16) 

C 

CALL  SRCH$S(KINDAM+K$RDWR,*TUSER»,5,16,1,IC)‘ 

C 

C OPEN  USER  FILE  (FUNIT  15) 

C 

CALL  SRCHS$(K$NDAM+KSR0UR,*USER*,3,15,1,IC) 

C ' 

C NOW  WRITE  USERS  LOGIN  ID,  DATE  (MUDDY),  TIME,  AND  USER  NUMBER 

C 

AMIN=ARRAY(3) 

■ AH=AHIN/60.0 
IH  = AH 
IMM=IH*60 
IMIN=AMIN 
IDM=IHIN-IMM 

25  WRITE(20,1)(ARRAY(I),I=13,15),IH,IDM,ARRAY(5), 

1 (ARRAY(I),I=1,3),ARRAY(12) 

1 F0RHAT(3A2,2(I3,»:*),I3,1X,2(A2,*/*),A2,I3> 

2 F0RMAT(3A2,2(I3,1X) ,I3,1X,2( A2,1X) ,A2,I3) 

C . . ' 

C NOW  COPY  THE  CONTENTS  OF  USER  TO  TUSER  ' ' 

C 

READ(19,2,ENO=50) (ARRAY( I) ,1=13,15) ,IH,I0M,ARRAY(5), 

1 (ARRAY(I),r=l,3),ARRAY(12) 

GO  TO  25 

50  CALL  SRCH$J(K$CLOS, ‘USER*, 3, 0,0,0) 


trill)  CALL  SRCHSS (KSCLOS* *TUSER»»5»0*0 *0) 

(0112)  CALL  SRCH$S(K$OELE»  *USERNA»0»0»0) 

(0113)  CALL  CNAMSS(»TUSER*fSi*USER»»A,IC) 

tOllA)  CALL  BREAKS ( .FALSE.  ) 

(0115)  RETURN 

(0116)  END 


o 

>~iO 

o 
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AH 

R 

0003A7 

AMIN 

R 

000351 

ARRAY 

I 

000002 

BREAKS 

R 

EXTERNAL 

000000 

CNAHSS 

R’ 

EXTERNAL 

000000 

I 

I 

000353 

:c 

I 

00035A 

TDENT 

I 

OCOOOO 

’.DM 

I 

000355 

iH 

I 

000356 

IMIN 

I 

000357 

IMM 

I 

000360 

KSALLD  I PARAMETER 
KiCACC  I PARAMETER 
KICLOS  I PARAMETER 
KSCONV  I PARAMETER 
KSCURR  I PARAMETER 
KSOELE  I PARAMETER 
KSDMPS  I PARAMETER 
KIDTIH  I PARAMETER 
KSENTR  1 000000 

KtEXST  I PARAMETER 
K$5CND  I PARAMETER 
KiGPOS  I PARAMETER 
KAHOME  I PARAMETER 
KiiC'JR  I PARAMETER 
KSIMFD  I PARAMETER 
KSIRTN  I PARAMETER 
KSIREG  I PARAMETER 
KSIJFD  I PARAMETER 
KSMENT  I 000000 

KSM.SIZ  I PARAMETER 
KSMVNT  I PARAMETER 
KINDAH  I parameter 
. KSMRTN  I PARAMETER 
KINSAM  I PARAMETER 
KSNSGO  I PARAMETER 
KSiVSGS  I PARAMETER 


0095M  0096 

009AM  009B  0098 

0079S  00B2A  009A  0100 

OOei  CllA 

0113 

OlOOM  0107H 

0086A  0090A  0113A 

007AS 

0099M  0100  0107H 

009£M  0097  0100  0107M 

009CM  0099 

0097M  0099 

P080S 

OOPOS 

COSOS  0110  0111 

0080S 

COBOS 

COSOS  0112 

0080S 

0080S 

0080S 

0080S 

OORCS 

COSOS 

OOPOS 

00  BOS 

COSOS 

0080S 

OOBOS 

0080S 

003PS 

OOBOS 

C08OS 

0080S  0086  0090 

008CS 

C08CS 

C030S 

OOBOS 


0107H 
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SUBROUTINE  IDENT 
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KSPOSA 

1 

PARAMETER 

0080S 

■<SPOSN 

I 

PARAMETER 

C080S 

KSPOSR 

I 

PARAMETER 

0080S 

KiPREA 

I 

PARAMETER 

0080S 

KSPRER 

I 

PARAMETER 

0090S 

KTPROT 

I 

PARAMETER 

0080S 

K&.ROUR 

I 

PARAMETER 

008CS 

0086 

0090 

KS  READ 

I 

PARAMETER 

OOSCS 

• 

KiRPOS 

I 

PARAMETER 

ooecs 

KSRSUB 

I 

PARAMETER 

0080S . 

KSRWLK 

I 

PARAMETER 

0030S 

• 

KSSENt 

I 

000000 

OOBOS 

KSSETC 

I 

PARAMETER 

0080S 

KiSETH 

I 

PARAMETER 

OOSCS 

KSSPOS 

I 

PARAMETER 

0080S 

r.SSRTN 

I 

PARAMETER 

ooecs 

•tSTRfJC 

I 

parameter 

0080S 

KSUPOS 

I 

PARAMETER 

ooros 

K$WRI.T 

I 

PARAMETER 

0080S 

SP.CHSS 

R 

EXTERNAL  000000 

0086 

0090 

0110 

0111 

0112 

T.TP.DAT 

R 

EXTERNAL  000000 

0082 

_1 

000157 

0100 

0102D 

I2 

000203 

0103D 

'0107 

* * 

25 

000077 

OlOOD 

0109 

~50 

00030A 

010  7 

OllOD 

0000  ERRORS  C<IDENT  >FTN-REV14. 2 3 


SUBROUTINE  IDUSER(IAI) 
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(CUT) 
(0118) 
(0119)  C 
(0120?  C 
(0121)  C 
(0122)  C 
(012i) 
(012A) 
(0125) 
(0126)  -102 
(0127) 
(0128) 
(0129) 
(0129)  101 

(0131 ) 
(0522)  103 

(0133) 
(013A) 
(0135) 


SUBROUTINE  IDUSER(IAI) 

1NTEGER»2  IP ASS ( A ) 1 1 A ( 1 5 ) 

THIS  ROUTINE  CHECKS  TO  HAKE  SURE  THAT  THE 
INCOHMING  USER  IS  VALID 

CALL  BREAKK.TRUE.) 

CALL  TIMDAT(IA»15) 

CALL  CLEAR 

IF(IA(13).NE.»SY»)  GO  TO  101 
IF ( IA( lA)  .NE . »ST* ) GO  TO  101 
IF( IA( 15) .NE.'EM’ ) GO  TO  101 
GO  TO  103 

CALL  COMINP(6HLOUSERtlO) 

CALL  EXIT 

CALL  BREAKS! .FALSE. ) 

IAI=IA(13) 

RETURN 

END 


SUBROUTINE  IDUSER(IAI) 
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BREAKS 

R 

EXTERNAL 

000000 

0123 

0132 

CLEAR 

R 

external 

000000 

0125 

r.OMINP 

R 

EXTERNAL 

000000 

0130 

EXIT 

R 

EXTERNAL 

000000 

0131 

lA 

I 

000005 

ones 

012AA 

:ai 

I 

ARGUMENT 

000003 

0117S 

0133H 

TCUSER 

I 

000000 

0117S 

I'PASS 

1 

00002A 

ones 

TIMUAT 

R 

EXTERNAL 

000000 

012A 

101 

000057  ■ 

. 0126 

0127 

1C2 

000037 

0126D 

103 

0C006A 

0129 

01320 

0126 


0128 


0127  0128 


0130'D 


0000  ERRORS  C<I0USER>FTN-REV1A. 2 3 


0133 


o 

'oi- 1. 


SUBROUTINE  TINPUT (TILiLEN) 


PAGE 


(0136) 
(0137)  C 
(0138)  C 
(0139)  C 
(Cl'tO)  C 
(0141)  C 
( 0 1 '*.2 ) C 
(01'i3>  C 
(01<f3)  C 
' (0143)  C 
(01'l3) 
(01*3) 
(0143) 
(0143) 
(0143)  C 
(0143)  C 
(0143)  C 
(01.43) 
(0143) 
(0143) 
(0143) 

(O'. 43) 

(0143) 

(014.3)  C 

(0143)  -C 

(0144) 

(0145.) 

(0146) 

(0147) 

(0148) 

(0149) 

(0150)  5 

(0151) 

(0152) 

(0153)  1 

(0154) 

(0155)  • 

(015S) 


SUBROUTINE  T I NPUT ( T IL» LEN ) 

TITLE  PACK  ROUTINE  ' 

THIS  ROUTINE  PACKS  THE  TITLE(S)  IN  A UNIFORM  MANNER. 
FOR  LATER  STORAGE  AND  RECALL 


COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

DRAW»TIT,PTIT,OTiSYS,VEH,SECT,NSHT*FREV,FNEO.FEOREFf 
DRUfSHTN,REV,NEO,EOREF» 

FON,ETIT ,EPTIT.EOREV,LDT»ERDT«EOVEH«  _ 

Rt IOR»INEO*KMT,l IRST.SrCONO,TTIT  : 

DATA  DECLARATION  BLOCK  FOR  THE.  DRAU^EO  FILE 

DRAW! 4) ♦TIT (21 ) ^PT I T ( 1 9 ) ♦ S YS ( 3 ) ♦ SECT ( 3 ) ♦ FEOREF ( 1 6 ♦ 2 ) ♦ 
DRW(4),E0REF(10t2)iEPTIT(19) ♦ETIT(21)tE0N(2)f 
IDR(4)tKNTtTTIT (19) 

0T(3) ♦VEH(2f2)rNSHT^SHTN(2)^FREV.FNE0fREV^NE0^  , 

EOREVt ECT (3) ♦ ERDT(3) fEOVEH(2t2) tR^INEOf 
FIRSTiSECOND 


COMMON  /X/  PEDL 

INTEGER *4  ARR A Y ( 4 ) ♦ ELNK ♦ T I L ( 2 1 ) 
I NT EGER *2  BUF(76) fDUFF(76)fPEDL 
CALL  RDCOM(BUF) 

DO  5 I=1^76 
BUFF(I)=aUF(i) 

CONTINUE 
BLNK  = *.  • 

DO  1 I=tf21 

TIL(I)=BLNK 

DO  11  I=lt20  . 

ARRAY(1)=BLNK' 

ARRAY(2)=ELNK 


1NTEGER*4 

1 

1 

INTEGER»2 

1 

1 


COMMON 

1 

1 

1 


0013 


SUBROUTINE  TINPUT ( T IL, LEM) 


(0?57) 

ARRAY(3)=BLNK 

(DIES) 

ARRAY(':  )=BLNK 

(01?9) 

CALL  GETWRD(DUF,ARRAY»LEN) 

(Di»;o> 

TIL(I)=ARRAY(1) 

<Clbl) 

TIL(I*1)=ARRAY(2) 

<0162) 

TIL(I+2)=ARPAY(3) 

(016S) 

TIL(I+3)=ARRAY(A) 

(oie-v) 

1 = 1 + 2 

(0165) 

12 

CONTINUE 

(0166) 

11 

CONTINUE 

(0167) 

PE0L=1 

(0168) 

DO  200  I=l»19’ 

(0169) 

200 

PTIT(I)=BLNK 

(0170) 

CALL  GETUD (PUFFiPTIT) 

(0171) 

211 

CONTINUE 

(0172) 

RETURN 

(0173) 

END 

D-17 


SUBROUTINE  T INPUT ( T IL t L EN ) 


ARRAY 

J 

000006 

0M5S 

0155M 

0156M 

0157H 

0158H 

C161 

0162 

0163 

BLNK 

J 

000R17 

01A5S 

0169 

0151M 

0153 

0155 

0156 

BUF  ■ 

I 

000016 

01A6S 

0147A 

0149 

0159A 

BUFF 

I 

00013? 

G1A6S 

0149H 

0170A 

DRAW 

J 

// 

000000 

0H3S 

DRU 

J 

// 

000226 

0 1 4 3 S 

CT 

I 

// 

000130 

0143S  • 

EOT 

I 

// 

000A37 

0143S 

FON  ^ 

J 

// 

000312 

0143S 

1 OREF 

J 

// 

0002A2 

0143S 

EOREV 

I 

// 

000R36 

0 1 4 3 S 

EOVEH 

I 

// 

OOOAA5 

0143S 

EPTIT 

J 

// 

000370 

0143S 

EROT 

I 

// 

000AA2 

0143S 

ETIT 

J 

n 

000316 

C143S 

FEOREF 

J 

n 

0 CO  156 

0143S 

FIRST 

I 

// 

000A65 

014  3S 

FNEO 

I 

// 

000155 

0143S 

FREV 

I 

// 

00015A 

C143S 

GETWO 

R 

EXTERNAL 

000000 

0170 

GETWRD 

R 

EXTERNAL 

000000 

C155 

I 

.1 

0C0A21 

0 1 4 8 M 

0149 

0152H 

0153 

0154H 

0162 

■ 0163 

0164M 

■ 0168H 

0169 

lOR  . 

J 

// 

000A52 

0143S 

INEO 

I 

// 

OOOA62 

C143S 

KNI 

d 

// 

DOORGS 

0143S 

LEN 

I 

ARGUMENT 

OOOOOA 

0136  5 

■ 0159A 

NEC 

I 

// 

0002A1 

0143S 

NSHT 

I 

// 

000153 

0143S 

PEEL 

I 

ni 

000000 

0144S 

0146S 

0167H 

PTIT 

J 

n 

000062 

0143S 

0169H 

0170A 

■ • 

R 

I 

n 

000A51 

0 1 4 3 S 

• 

RDCdH 

R 

EXTERNAL 

000000 

0147 

REV 

I 

// 

0002AO 

0143S 

SECOND 

I 

// 

OOOA66 

0143S 

SECT 

d 

// 

0C0H5 

0143S 

PAGE  0015 


0159A  0160 

0157  0158 


0160  0161 


D-18  ■ 
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SUBROUTINE  TINPUT ( T IL . L EN ) 
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SHTN 

I 

// 

000236 

01A3S 

SVS 

J 

// 

000133 

01 A3S 

TIL 

J 

ARGUMENT 

000003 

0136S 

TINPUT 

R 

000000 

0136S 

TIT 

J 

// 

000010 

C1A3S 

TTIT 

J 

// 

000A67 

0143S 

VEH 

1 

// 

OOOlAl 

0143S 

1 

000275 

0152 

•U 

000357 

0154 

Il2  ■ 

000357 

' 0165D 

. 200 

000372 

C160 

_211 

COO A15 

0171P 

_5 

000256 

014S 

0145S  0153K  0160H  0161H  0162H 

01530 

01660 

01690 

01500 


0000  ERRORS  C<TINPUT>FTN-REV1 A.2 3 
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C READ  ONE  LINE  FROHCONSOLE  OR  COMMAND  FILE 


(017A)  C READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 
(0175)  C 
(0176)  C 

(C177)  SUBROUTINE  RDCOM(SUF) 

(0178)  C 

(0179)  COMMON  /X/  PEDL 

(0180)  C 

(0161)  INTEGER  BUF ( 1 ) , PE DL tCHAR ♦ ANL , AK I LL , AER A SE 

(01H2)  C 

(Oir.3)  C ANL,  AKILL.  AERASE  ARE  OCTAL  ?12,  277,  2A2 

(018A)  DATA  ANL, AKILL, AERASE/138, 191, 136/ 

(0185)  C 

(0186)  PEDL=1 

(0187)  90  N=1 

(0188)  100  CALL  CIIN(CHAR) 

(0189)  BUF(N)=CHAR 

(0190)  IF(CHAR.EQ.ANL)  RETURN 

(0191)  IF(CHAR.EQ. AKILL)  GOTO  90 

(0192)  IF(CHAR.EQ. AERASE)  GOTO  200 

(0193)  N=N+l 

(019A)  IF(N.GT.77)  GOTO  999 

(0195)  GOTO  100 

(0196)  C 

(0197)  200  IF(N.LE.2)  GOTO  90 

(0198)  . N = N-1  • 

(0199)  GOTO  100 

(0200)  C 

(0201)  999  ILF=:212  ' 

(0202)  CALL  TIOU(ILF) 

(0203)  RETURN 

(0204) . END 


PAGE  0017 


c 


READ  ONE  LINE  FROM  CONSOLE  OR  COMMAND  FILE 


AERASE 

I 

000007 

OIPIS 

AKILL 

I 

OCOOOG 

0181S 

ANL 

I 

000005 

oieis 

BUF 

I' 

ARGUMENT 

000003 

0177S 

Cl  IN 

R 

EXTERNAL 

000000 

0188 

CHAR 

I 

000071 

0181S 

ILF 

I 

000072 

020 IH 

N 

I 

000073 

0187M 

PEOI. 

I 

/X/ 

000000 

0179S 

RDCOM 

R 

000000 

01  77S 

TlOU 

R 

EXTERNAL 

000000 

0202 

_10  0 

000016 

01880 

~2  0 0 

000051 

0192 

~9C 

000013 

01870 

999 

000062 

0198 

01881 

01881 

01881 

0181S 

0192 

0191 

0190 

0189H 

0188A 

0202A 

0189 

0190 

0191 

0192 

0189 

0181S 

0193M 

0186M 

0198 

0197 

0198H 

0195 

0199 

01970 

0191 

0197 

02010 

0000  ERRORS  C<RDCOM  >FTN-REV1A  .2:  3 


c 


FETCH  ONE  ‘UORO*  FROM  BUFFER  FILLED  BY  RDCOH 
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(0205)  C 
(0206)  C 
(0207)  C 
(0208) 
(0209)  C 
(0210) 
(0211)  C 
(C212) 
(0213) 

(02 IS  5 C 
(0215»  C 
(0216)  C 
(02'<,7)  C 
(021B)  C 
(0219) 

( 0220) 
(0221)  C 
(0222) 
(0223)  100 

(0224)  C 
(0225) 

( 0226) 
(0227) 
(0228) 
(0229) 
(0230)  999 

(0231)  200 

(02:-2) 
(0233) 

( 0234) 
(0235) 
(0236) 
(0237) 
(0238) 
(0239) 
(0240) 

(0241  ) 
(0242) 


FEtcH  ONE  'WORD*  FROM  SUFFER  FILLED  3Y  RDCOM 


SUBROUTINE  GET WR D ( BUF » N AHE» LEN) 

COMMON  /X/  PEDL 

INTEGER  BUF(l), PEDL, NAHE(l), CHAR, 

♦ ANL, ACOMMA,ASCOL,ASP,ASPSP 

ANL,ACOHMA,ASCOL,ASP,ASPSP 
ARE  OCTAL 

212,254,273,240,120240 

DATA  ANL, ACOMMA,ASCOL/138, 172,187/, 

♦ ASP, ASPSP/160,2H  / 

DO  100  1=1,3 
NAHE( I )=ASPSP 

N = 1 

IF(BUFd)  .NE.ASP)  GO  TO  200 
DO  999  1=2,77 
11=1-1 

BUFdl  )=BUF(  I) 

CONTINUE 

CHAR=BUF(PEDL) 

PEDL=PEDL+1 

IF(PEDL.GT.77)  RETURN 
IF(CHAR.EQ.ANL)  GOTO  400 

IF(CHAR.EQ.ASP.OR.CHAR.EQ.ACOHMA.OR.CHAR.EQ.ASCOL)  GOTO  300 

IF(N.GT.LEN)  GOTO  200 

I=(N+l)/2 

J=N-2»(N/2) 

N = N + 1 

IF(J.EQ.l)  GOTO  250 
NAHE(I)=LT(NAHE(I),8)  ♦ CHAR 
GOTO  200 


C FETCH  ONE  'UORD*  FROM  BUFFER  FILLEC  BY  RDCOM  PAGE  0020 


(0243) 

250 

NAME(I)=  RT(NAME( I>f8)  ♦ LS(CHAR,8) 

(0244) 

GOTO  200 

(02**5) 

C 

(0246) 

300 

CHAR=BUF(PEDL) 

(0?*f7) 

IF(CHAR.EQ.ANL)  GOTO  400 

(0248) 

IF (char.NE. Asp.and.char.ne.acomha.and.char.ne.ascol)  return 

(024°) 

PE0L=PEDL+1 

<02505 

goto  300 

(025;) 

C 

(025?) 

400 

PEDL=77 

(0253) 

RETURN 

(0254) 

C 

(0255) 

END 

-C.ro 

O 
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C TETCH  ONE  •WORD*  FROM  SUFFER  FILLED  BY  RDCOM  PAGE  0021 


ACOHMA 

I 

000010 

0212S 

C219I 

0235 

0248 

ANL 

I 

000007 

0212S 

02191 

0234 

0247 

ASCOL 

I 

000011 

0212S 

02191 

0235 

0248 

ISP 

I 

000012 

0212S 

02191 

0226 

0235 

0248 

ASPSP 

I 

000013 

0P12S 

02191 

0223 

BUF 

I 

ARGUMENT 

000003 

020?S 

C212S 

0226 

0225M 

0231 

0246 

CHAR 

I 

0002‘(3 

0212S 

0231H 

0234 

0235 

0241 

0243 

0246M 

0247 

0248 

GETWRD 

R 

000000 

0208S 

I 

I 

000244 

0222M 

0243 

0223 

0227M 

0228 

0229 

0237H 

0241 

II 

I 

000246 

0228M 

0229 

J 

I 

000247 

0239M 

0240 

LEN 

I 

ARGUMENT 

000005 

02CSS 

0236 

LS 

I 

EXTERNAL 

000000 

0243 

LT 

I 

EXTERNAL 

cooooo 

0241 

N 

I 

000252 

0225M 

0236 

0237 

0238 

0239M 

NAME 

I 

ARGUMENT 

000004 

0208S 

0212S 

0223H 

0241M 

0243M 

PEDL 

I 

/X/ 

000000 

C210S 

0252K 

0212S 

0231 

023PM 

0233 

0246  . 

0249M 

RT 

R 

EXTERNAL 

000000 

0243 

_10  0 

000017 

0222 

0223D 

”200 

000070 

0226 

02310 

0236 

0242 

0244 

l250 

000174 

0240 

C243D 

..3  0 0 

000207 

0235 

0246D 

0250 

_A00 

000240 

0234 

02*7 

02520 

l999 

000061 

0227 

0230D 

0000  ERRORS  C<GETWRD>FT N-R E V14 . 2 3 
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SUBROUTINE  GETWD { BUFF tNAME  ) 


PACE  0022 


CO 


(02b6) 
(02'-:7)  c 
(0258) 
<0259)  C 
(0260) 
(0261) 
(0262)  C 
(0263)  C 
(026A)  C 
(0265)  C 
(0266)  C 
(0267) 
(0268) 
(o::69)  c 
(0270' 
(0271)  100 

(0272)  C 
(0273) 
(027-n 
(0275) 
(0276) 
(0277) 
(0278)  999 

(0279)  200 

(0280) 
(0281) 
(0282) 
(0283) 
<0278) 
(0205) 
(0286) 
(0287) 
(0288/ 
(0289)  250 

(0290) 
(0291)  C 
(0292)  C 
(0293)  AOO 


SUBROUTINE  GETUD ( BUFF tN AHE) 

COMMON  /X/  PEDL 

INTEGER  BUFF(l) ,PEDL,NAME(1) tCHAR, 

♦ anl»acomma,ascol»asp»aspsp 

ANL*ACOHMA*ASCOL, ASP,ASPSP 
ARE  octal 

212»25A,273f2A0  , 120240 

DATA  ANL, ACOMHA»ASCOL/138.172f 187/, 
ASP,  ASPSP/160,2H  / 

DO  100  1=1,19 
NAME(I)=ASPSP 

N = 1 

IF(BUFFd).NE.ASP)  GO  TO  200 
DO  999  1=2,77 
11=1-1 

BUFF(II)=BUFF(I) 

CONTINUE 

CHAR=BUFF(PEDL) 

PEDL=PEDL+1 

IF(PEDL.GT.77)  RETURN 
IF(CHAR.EQ.ANL)  GOTO  400 
I=(N+l)/2 
J=N-2*(N/2) 

N = N+1 

IF(J.EO.l)  GOTO  250 
NAME(I)=LT(NAME(I),8)  + CHAR 
GOTO  200 

NAHE(I)=  RT(NAME( I ) ,8)  ♦ LS(CHAR,8) 
GOTO  200 


PEOL=77 


) 


■') 


SUBROUTINE  GETUO ( BUFF » NAME > PAGE  0023 


i 

(029A)  RETURN 

(02S3)  END  ■ i 
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SUBROUTINE 


GETUO (BUFFtNAME  ) 


PAGE  002A 


ACOMHA 

I 

000007 

02S0S 

02671 

AN'L 

I 

OOOOOG 

026CS 

02671 

0282 

ASCOL 

I 

000010 

0260S 

02671 

ASP 

I 

000011 

C260  S 

02671 

027A 

ASPSP 

I 

000012 

026CS 

02671 

0271 

BUFF 

I 

ARGUMENT 

000003 

0256S 

0260S 

0274 

0277M 

0279 

CHAR 

I 

00016A 

0260S 

0279M 

0282 

0287 

0289 

GEIUD 

R 

000000 

0256S 

I 

I 

000165 

0270M 

0271 

0275H 

0276 

0277 

0283M  0287 

0289 

II 

I 

000167 

0276M 

0277 

J 

I 

000170 

C28AM 

0286 

LS 

I 

EXTERNAL 

000000 

02  8 9 

LT 

I 

EXTERNAL 

COOOOO  ' 

0287 

N 

I 

000171 

0273H 

0283 

0284 

0285H 

MAHE 

I 

ARGUMENT 

000  OOA 

0256S 

0260S 

C271H 

0287M 

0289M 

°EOL 

I 

/X/ 

000000 

0258S 

0260S 

0279 

02S0M 

0281 

0293H 

RT 

R 

EXTERNAL 

000000 

0289 

.10  0 

OOOOIG 

0270 

C271D 

_200 

000067 

027A 

0279D 

0288 

0290 

_2^.0 

000  1A6 

0286 

0289D 

_A(10 

000161 

0282 

0293D 

l909 

000060 

0275 

02780 

0000  ERRORS  C<GETUO  >FTN-RE VI A . 2 I 


SUBROUTINE  ARCDW 
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(029£) 

(0297: 

(0297) 

(0297) 

(029V) 

(029V) 

(0  29  / ) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0297) 

(0296) 

(0298) 

(0299) 

(0300) 

(0301) 

(0302) 

(0303) 

(030A) 

(0305) 

(0306) 

(0307) 

(0308) 

(0309) 

(0310) 

(0311) 

(0312) 

(0313) 

(031A) 

(0315) 


SUBROUTINE  ARCDW 
C 

C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 
C 

COMMON  ORAU,TIT»PTIT,DT»SYS,VEH,SECT»NSHT,FREV»FNEO»FEOREF» 

1 DRW»SHTN,REV,NEO»EOREF, 

1 fON,ETIT«‘EPTITtEOREV*EDT,ERDT,EOVEH» 

1 Rf IDR,INEO»KNTtFIRST«SECOND*TTlT 

C 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

C 

INTEGER*A 

1 
1 

INTEGER*2 

1 
1 
C 
C 

C SYSCOM>KEYS.F 
NOLIST 
INTEGER*2 
C 

c 

C ARCHIVE  ROUTINE  FOR  THE  DRAW  FILE 

c ■ 

C VALIDATE  THE  INCOMMING  USER 

C 

CALL  IDUSER(IAI) 

IFdAI.EQ.’SY*)  GO  TO  5 
WRITE(lt500) 

500  FORMAT! ’GGSORRY  YOU  ARE  NOT  VALIDATED  TO  USE  THIS»t 

IIX'ROUTINE ’*/» » IF  IT  IS  NEEDED  CONTACT  YOUR  SYSTEMS’t 
11X»  PROGRAMMER  AT  EXT  2621*/////) 

RETURN 

5 WRITE(li6) 

6 FORMAT!*  DO  YOU  WISH  TO  ARCHIVE  DRAWINGS  OR  E.O.»»S  (DR  OR  EO)*) 

READ(1»7)I0PT 


DRAW(A),TIT(21).PTIT(19),SYS(3)»SECT(3)«FEOREF(10t2)* 
DRU(A>,EOREF(10,2) ,EPTIT(19) ,ETIT(21),E0N(2) . 
IDR(A),KNT,TTIT(19) 

DT(3)  ,VEH (2,2 ) fMSHT«SHTN(2) «FREV,FNEO»REV,NEO» 
EOREV.EOT (3) ,ERDT(3) ,ECVEH(2,2) ,R,INEO, 

FIRST, SECOND 


MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY,  1977 

lOPT 
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O 


(0316) 
(031 7) 
(0318) 

7 

(0319) 

10 

(0320) 

(0321) 

(0322) 

1 

(0323) 

(C32A) 

2 

(0325) 
(0326) 
(0327) 
(0328)  . 

(0329) 

C 

(0330) 

C 

(0331) 

(0332) 

50 

(0333) 
( 033A  ) 

60 

(0335) 

75 

(0336) 

82 

(0337) 

(0338) 

(0339) 

fiO 

(03A0) 

81 

(03A1) 

(03A2) 

(03A3) 

100 

(03AA) 

(03A5) 

150 

(0346) 

(0347) 

(0348) 

152 

(0349) 

(0350) 

(0351) 

155 

(0352) 

(0353) 

16(1 

F0RHAT(1A2) 

IF(IOPT.EQ.*EO»)  GOTO  300 
IF( lOPT.NE.’DR’)  GOTO  5 
URITE(l.l) 

F0RMAT(»  WELCOME  TO  THE  DRAWING  FILE  ARCHIVE  ROUTINE»»/ 

!•  HOW  MANY  DRAWINGS  DO  YOU  WISH  TO  ARCHIVEN/) 

READ(lt2»ERR=10)IKNT 

FORHATdB) 

IF(IKNT.EQ.O)  RETURN 

CALL  SRCHJJ (KJRDWR+K$NDAM,*INACTD»,6f5.1 «ICJ 
CALL  SRCHtl(KSR0UR-^KSNDAM,*INACTS*«6t7»l,IC) 

CALL  SRCHS$(K$RDWR+K$NDAM,»TEHP  *i£»6*ltIC) 

CALL  SRCHJS (KJRDWR+KSNDAM, *STEMP  *»A*10,1.IC) 

PLACE  THE  ARCHIVE  FILE  AT  THE  EOF  MARKER 

READ(9,END  = 60)DRAJ,TIT,PTIT.DT»SYS,VEH,SECT»NSHT  tFREV»FNEO «FEOREF 
GO  TO  50 

REAOO 1»EMD=75)DRW .SHTN*REV,NLO,EOREF 
GO  TO  60 

DO  9999  ILOOP=ltIKNT 
WRITEdiSO) 

FORMAT!*  WHAT  IS  THE  DRAWING  NUMBER  OF  THE  DRAWING  ♦♦ 

1*  YOU  WISH  TO  ARCHIVE**/) 

READd  *81  *ERR  = 82)  IDR 
F0RMAT(3AA*A2> 

REAO(6*ENO=200)DRAW*TIT*PTIT*DT*SYS»VEH*SECT*NSHT*FREV*FNEO*FEOREF 
DO  150  I=1*A 

IFdDRd)  .NE.DRAWd)  ) GO  TO  125 
CONTINUE 

WRITE(9)0RAW*TIT*PTIT*DT*SYS*VEH*SECT,NSHT,FREV*FNE0*FE0REF 

READ(12*END=165)DRW*SHTN*REV*NE0*E0REF 

DO  155  K=1*A 

IFdDR(K)  .NE.DRW(K)  ) GOTO  160 
CONTINUE 

WRITEd l)DRW*SHTN*REV,NEO*EOREF 
GO  TO  152 

WRITE(lA)DRW*SHTN*REV*NEO*EOREF 
GO  TO  152 
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(03n4) 
(0355) 
(0356) 
(0357) 
(0358) 
(0359) 
(0360) 
(036)  ) 
(0562) 
(0363) 
(036A) 
(0365) 
(0366) 
(0367) 
(0368) 
(0369) 
(0370) 
(0371) 
(0372) 
(0373) 
(037A) 
(0375) 
(0376) 
(0377) 
(0373) 
(0379) 
(0330) 
(0381) 
(0382) 
(0383) 
( 038‘i ) 
(0385) 
(0386) 
(0387) 
(0388) 
(0389) 
(0390) 
(0391) 


i65 


125 

200 


9999 


300 

302 

305 

310 

320 
33  0 


CALL  SRCHS$(KJCLOS» ’SHEET  *t6, 0,0*0) 

CALL  SRCH$i(KSCLOS, *STEHP  », 6, 0,0,0) 

CALL  SRCH$S(K$DELE, ’SHEET  ’,6. 0,0,0) 

CALL  CNAHSI  ( ’STri?  ’,6, ’SHEET  ’,6,10 
CALL  SRCHSS (KlROyR+KlNDAH, ’SHEET  ’,6,8,1,10 
call  SRCHt$(K$RD'.’P*K!(MDAM,’STrHP  ’,6,10,1,10 
CO  TO  100 

WRITE( 10) DRAU,TIT,PTIT,DT,SYS,VrH,SECT,NSHT,FREV,FNEO,FEOREF 
GO  TO  100 

CALL  SRCH$S(K$CLOS, ’DRAW  ’,6, 0,0,0) 

CALL  SRCH3$(K1DELE, ’DRAW  ’,6, 0,0,0) 

CALL  SRCHSt (KSCLOS, *TEHP  ’,6, 0,0,0) 

CALL  CNAMSK’TEHP  ’,6, ’DRAW  ’,6,10 
CALL  SRCH$S(KIRDyR+K$NDAK,’DRAU  ’,6,2,1,10 
CALL  SRCHSt(KSROWR+K$NOAM,’TEMP  ’,6,6,1,10 
CONTINUE 

ENDFILE  9 ' 

ENDFILE  11 

CALL  SRCHSS(KlCLOS, ’INACTD’,6,0.0,0) 

CALL  SRCHS$(K$CLOS, ’INACTS’,6,0,0,0) 

CALL  SRCH$t(KlCLOS, ’TEMP  ’,6, 0,0,0) 

CALL  SRCH$1(K$CL0S, ’STEMP  ’,6, 0,0,0) 

CALL  SRCHIS(K$DELE, ’TEPP  ’,6, 0,0,0) 

CALL  SRCHIKKSDELE, ’STEMP  ’,6, 0,0,0). 

RETURN 

CALL  SRCHSI(K1RDUR+K$NDAM,’INACTE»,6,13,1,IC) 

CALL  SRCHIi(KSPCUR+KSNDAH,’ETEMP  ’,6,9,1,10 
REAO(17,END=305)EON,ETIT,EPTIT,EOREV,EDT.ERDT,EOVEH 
GO  TO  302 
UR1TE(1,310) 

FORMAT!’  PLEASE  STAND  BY.  SYSTEM  IS  NOW  ARCHIVING  UNREFERENCED  F. 
10. ”S’) 

READ(ia,ENO=AOO)EON,ETIT,EPTIT,EOREV,EDT,ERDT,EOVEH 
READ(12,ENO=335)DRW,SHTN,REV,N£0,EOREF 
IF(NEO.EQ.O)  GOTO  330 
DO  323  1=1,10 
DO  327  J=l,2 

IF(EOREF( I, J).NE.EON( J) ) GOTO  323 
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(C392)  327 

(0393) 
(039A)  323 

(0393) 
(0396)  325 

(0397) 
(0398) 
(0399)  335 

(OAOO)  3A0 
(0901) 

(0902) 

(0903) 
(0909) 
(0905)  337 

( 0-0£) 
(0'07)  393 

(09C8) 

,1^  (0909)  395 

(0910) 

^ (0911) 

(0912)  350 

(0913) 
(0919) 
(0915) 

(0916)  360 

(0917) 

(0918)  .900 

(0919) 

(09,20) 

(0921) 

(0922) 

(09J3) 

(0929) 

(0925) 


CONTINUE 
GO  TO  325 
CONTINUE 
GO  TO  330 

WRITE(13)E0N,ETIT,EPTIT,E0REV»EDT»ER0T.E0VEH 
REWIND  12 
GO  TO  320 
REWIND  12 

READ(6,END=350)DRAW,TIT,PTIT,DTtSYS,VEH,SECT»NSHT,FREV,FNEO»FEOREF 
IF(FNEO.EQ.O)  GO  TO  390 
DO  393  1=1,10 
DO  337  J=l,2 

IF(FEOREF(I,J).NE.EON(J))  GOTO  393 
CONTINUE 
GO  TO  395 
CONTINUE 
GO  TO  390 

WRITE(13)E0N,ETIT,EPTIT,E0REV,EDT,ER0T,E0VEH 
REWIND  6 
GO  TO  320 

WRITE(17) EON,ETIT,EPTIT, EOREV,EDT,ERDT,EOVEH 
REWIND  6 

REWIND  12  • 

WRITE(1,360)EON 

FORMAT!*  E.O.  »,2A9,*  HAS  BEEN  ARCHIVED.*) 

GO  TO  320 

CALL  SRCH$$(K$CLOS, *EO  *,6,0, 0,0) 

CALL  SRCHtS (KSCLOS, *ETEMP  *,6,0, 0,0) 

CALL  SRCH$$(KSCLOS,*INACTE*,6,0,0,0) 

CALL  SRCHtS (KSDELE, *EO  », 6, 0,0,0) 

CALL  CNAH$$( *ETEMP  *,6,*E0  *,6,IC) 

CALL  SRCHtt (K$RCUR  + K$NDAM,  *EO  *,6,19,1,10 

RETURN 

END 
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ARCOU 

R 

000000 

CNAHiJ 

R 

external 

COCOOO 

URAU 

J 

// 

OOOOOO 

DRU 

J 

// 

000226 

UT 

I 

// 

000130 

EOT 

I 

// 

000437 

EON 

J 

// 

000312 

EOREF 

J 

// 

000242 

ECREV  ■ 

■ I 

// 

000436 

EOVEH 

I 

// 

000445 

EPTIT 

J 

// 

000370 

ERDT 

I 

// 

000442 

ETIT 

J 

// 

000316 

FEOREF 

J 

// 

000156 

FIRST 

I 

// 

000465 

F.NEO 

I 

n 

000155, 

o 

FREV 

I 

n 

000154 

CO 

I 

I 

002207 

— * 

I.U 

I 

002211 

IC 

I 

002212 

ICR 

J 

// 

000452 

IDIISER 

I 

EXTERNAL 

onoooo 

IK  NT 

I 

002213 

ILOOP 

I 

002214 

INEO 

I 

// 

000462 

I OPT 

I 

002215 

J 

I 

002216 

K 

I 

002217 

KSALLO 

I 

PARAMETER 

KSCACC 

I 

PARAMETER 

K$CL0S 

I 

PARAMETER 

KICONV 

I 

PARAMETER 

KiCURR 

I 

PARAMETER 

KSOELE 

I 

PARAMETER 

KJCNPB 

I 

PARAMETER 

029ES 


0357 

0366 

0422 

0297S 

0331M 

0341M 

0343 

0345 

0297S 

0333H 

0 34  6M 

0348 

0350 

C297S 

0331M 

0341M 

0345 

0361 

0297S 

038 IM 

0 386M 

0396 

0409 

0297S 

0381M 

0386M 

0391 

0396 

0412 

0415 

0257S 

0333M 

0346M 

0350 

0352 

0297S 

0 38  IM 

0386M 

0396 

0409 

0297S 

C381M 

0386M 

0396 

0409 

0297S 

C381M 

038  6M 

0396 

0409 

0297S 

0381M 

0386M 

0396 

0409 

0297S 

0381M 

0386H 

0396 

0409 

0297S 

C297S 

0331M 

0341M 

0345 

0361 

0297S 

0331M 

0341M 

0345 

0361 

0297S 

0331M 

0341M 

0345 

0361 

0342M 

0343 

0309H 

0391 

0402M 

0306A 

0307 

0325A 

C326A 

0327A 

0328A 

0357A 

0366A 

0367A 

0368A 

0379A 

0380A 

0297S 

0339M 

0343 

0348 

• 

0306 
C322M 
03  3 5M 
0297S 

0324 

0335 

0299S 

0315M 

0317 

0318 

0340M 

0391 

0 40  3M 

0404 

034  7M 
C296S 
02965 

0348 

0298S 

0354 

0355 

0363 

0365 

0374 

0375 

0418 

0419 

0420 

029BS 

029PS 

0296S 

02965 

0356 

0364 

0376 

0377 

PAGE  0029 


0361 

C400M 

0352 

0400M 

0412 

0387M 

0404 

0409 

0387M 

0412 

0391 

0412 

0412 

0412 

0412 

0400M 

0404 

0400M 
0 4 0 0 M 
0404 

0401 

035RA 

0359A 

0422A 

0423A 

0372  0373 


0421 
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KIDTIH  I PARAMETER 
KSENTR  I 0 

KiEXST  I PARAMETER 
KSGOND  I PARAMETER 
KIGPOS  I PARAMETER 
KIHOME  I PARAMETER 
KSIC'JR  I PARAMETER 
KilMFD  I PARAMETER 
KlIRTN  I PARAMETER 
rSISEG  I PARAMETER 
:tIIUFD  I PARAMETER 
KSMENT  I 0 

KSMSIZ  I PARAMETER 
KSMVfJT  I PARAMETER 
KSNOAM  I PARAMETER 

a KiNRtN  I Parameter 

(jvjco  KSrJSAM  1 parameter 

. TO  KINSGO  I parameter 

KSNSGS  I PARAMETER 

a ksposa  I parameter 

KSPOSM  I PARAMETER 
KiPOSR  I PARAMETER 
KIPREA  I PARAMETER 
KSPRER  'l  PARAMETER 
KSPROT  I PARAMETER 
KSR.DUR  I PARAMETER 

KSREAO  I PARAMETER 
KIRPOS  I PARAMETER 
KSRSU3  I PARAMETER 
KSKWLK  I PARAMETER 
KSSENT  1 0 

KSSETC  I PARAMETER 
XtSETK  I PARAMETER 
KSSPOS  I PARAMETER 
KSSRTN  I PARAMETER 
KSTRNC  I PARAMETER 


0298S 
00000  0298S 

0298S 
029BS 
029PS 
0298S 
029ES 
0298S 
P29ES 
029PS 
0298S 
00000  P296S 

C298S 
0 2 9 8 5. 

02'i8S  0325  0326 

0367  0368  0379 

0298S  ■ 

0298S  . 

0 2 9 8 S 
0298S 
0 2 9 f,  S 
• 0298 S 
029RS 
029ES 
0298S 
O290S 

0296S  0325  0326 

0367  0368  0379 

0298S 

0256S 

0298S 

0298$ 

00000  0298$ 

0298S 

029PS 

0298$ 

C29PS 

0298$ 


0327 

0380 


0327 

0380 


0328 

0A23 


0328 

0423 
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KSUPOS 

I 

parameter 

0258S 

KSURIT 

I 

PARAMETER 

0296  S 

KNT 

J 

// 

000463 

0297S 

NEO 

I 

// 

000241 

0297S 

0333M 

0346M 

0350 

NShT 

I 

// 

000153 

0297S 

0331M 

0341H 

0345 

PUT 

J 

// 

000062 

0297S 

0331M 

0341H 

0345 

R 

I 

// 

000451 

C297S 

REV 

I 

// 

000240 

0297E 

0333M 

0 34  6H 

0350 

SECOND 

I 

// 

000466 

0297S 

SECT 

J 

// 

000  145 

C297S 

0331M 

0341H 

0345 

SHTN 

I 

// 

000236 

C297S 

0333H 

0346M 

0350 

SRCHJt 

R 

EXTERNAL 

000  000 

0325 

0326 

0 32  7 

0328 

0358 

035'? 

0363 

0364 

0372 

0373 

0 374 

0375 

0380 

0418 

0419 

0420 

SYS 

J 

.// 

000133 

0297S- 

0331H 

034  IM 

0345 

TIT 

J 

// 

000010 

0297S 

0 3 3 1 H 

0 341M 

0345 

TTIT 

J 

// 

000467 

0297S 

7EH 

I 

// 

000141 

D297S 

0331M 

0 341M 

0345 

_1 

000215 

0319 

0320D 

000211 

0319D 

0322 

_10  0 

000547 ' 

C341D 

0360 

0362 

Il25 

001117 

0343 

0361D 

150 

000641 

0342 

0344D 

152 

000714 

0346D 

0351 

0353 

_155 

000762 

0347 

0349D 

160 

001013 

0348 

0352D 

_165 

001037 

0346 

0354D 

_2 

000307 

0322 

03230 

200 

001165 

0341 

03630 

l300 

001343 

0317 

03790 

302 

001363 

0381D 

0382 

~3  0 5 

001417 

0381 

03830 

001424 

0383 

03840 

_320 

001467 

0386D 

0398 

0411 

0417 

_323 

001616 

0389 

0391 

03940 

_325 

001624 

0393 

03960 
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0352 

0387M 

0388 

0361 

0400H 

0361 

0400M 

0352 

0 33  7H 

0361 

0400H 

0352 

0387M 

0354 

0355 

0356 

0365 

0367 

0368 

0376 

0377 

0379 

0421 

0423 

0361 

0400H 

0361 

04C0H 

0361 

0400M 
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327 

001607 

0390 

03920 

_330 

001522 

03870 

0388 

335 

001660 

0387 

03990 

_337 

001769 

0903 

C905D 

390 

001662 

0900D 

0901 

_393 

001772 

0902 

0909 

395 

002000 

0906 

C909D 

350 

002033 

0900 

09120 

_360 

002100 

0915 

09160 

_9  0 0 . 

002129 

0336 

09180 

_5 

000122 

0307 

03130 

-5  0 

000356 

03310 

0332 

500 

000016 

0308 

03090 

6 

000126 

0313 

03190 

_60 

000926 

0331 

03330 

7 

000173 

0315 

03160 

000959 

03  33 

03350 

80 

000969 

0336 

03370 

81 

000592 

03  J9 

03900 

_82 

000957 

03360 

0339 

_9999 

001299 

0335 

03690 

0000  ERRORS  C<ARCDW 

>FTN-REV19.23 

PAGE 

0395 

0 908 
0907D 

0318 

0339 


0032 
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(0A26)  SUBROUTINE  SEADU 

(0'f27)  C 

(0A27>  C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

(0A27)  C 

<0A27)  COMMON  DR AU , T I T ,PT I T , OT , S YS , V EH,S ECT , NSHT« FRE V , FNEO t FEOREF  , 

<0A27)  1 DRW,SHTN,REV,NEO,EOREF, 

(0A27)  1 EON.ETIT*EPTIT,EOREV»EOT»ERDT,EOVEH» 

(0427)  1 Ri IDR. INEO,KNTfFIRST.SECOND*TTIT 

(0427)  C 

(0427)  C DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 

(0427)  C 

(0  427)  INTEGER *4  DRAW(4),TIT(21) , PT I T ( 1 9 ) , S YS ( 3 ) t SECT ( 3 ) »FEOREF( 1 0 1 2 ) . 

(0427)  1 ORU(4),rOREF (10,2) ,EPTIT(19) ,ETIT(21) ,E0N(2) » 

(0427)  1 IDR (4) ,KNT,TTIT (19) 

(0427)  INTEGER*2  DT(3)»VIH(2,2),NSHT,SHTN(2),FRFV,FNE0,REV,NE0, 

(0427)  1 E0REV,E0T(3),ERDT(3),E0VEH(2,2),R,INE0, 

(0427)  1 FIRST, SECOND 

(0427)  C 
(0427)  C 

(0428)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  KAY,  1977 

(0428)  NOLIST 

(0429)  INTEGER*2  IDES,IORT 

(0430)  C 

(0431)  C this  is  the  SEARCH  DRIVER  ROUTINE  FOR  THE  DRAW  FILE 

(0432)  C 

(0433)  J=:401 

(0434)  RrO 

(0435)  CALL  SRCH $$ ( K$R DWR*K$NSAM  , • OUT  »,6,3,0,0) 

(0436)  WRITE(7,9999) J 

(0437)  9999  F0RMAT(1A2) 

(0438)  WRITE(1,1) 

(0439)  1 FORMATC  YOU  ARE  NOW  VALIDATED  TO  SEARCH  DATA  IN  THE  »,/ 

(04401  1»  DRAWING  FILE  - THE  FOLLOWING  SEARCH  MODES  •,/' 

(0441)  1»  ARE  AVAILABLE  FOR  YOUR  USE  - •,/ 

(0442)  I’MODE  KEY*,/ 

(0443)  2*TITLE  TITLE*,/ 

(0444)  3*DRAWING  NUMBER  DRAW*,/ 

(0445)  4»DRAWING  DATE  DATE*,/ 
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(0446) 

S*SYSTEH 

SYS*,/ 

(0447) 

1*VEHICLE 

VEH*,/ 

(04)8) 

l*SECTION 

SECT*,/ 

(0449) 

l*VENDOR  CODE 

CODE*,/ 

(0450) 

1 *ALL 

ALL*,/ 

(0451) 

1*REV  ACTION  DUE 

ACT*,/ 

(0452) 

l*E.O.  NUMBER 

EO*  ,/ 

(0453) 

1*QUIT 

QUIT*,/ 

(0A5A)  1»  PLEASE  SELECT  THE  DESIRED  HODE»t//) 

(0A55)  REWIND  6 

(0A56)  6 READ(1*3)IDES 

(0A57)  3 F0RHAT(1A2) 

(0A58)  IF( IDES.EO. *QU* > GOTO  10 

f0''59)  100  URITE(l.llO) 

(0A60)  110  F0RHAT(1X,»D0  YOU  DESIRE  THE  OPTIONAL  BRIEF  OUTPUT**/, 

«('t61)  1*  RECOMMENDED  FOR  ALL  AND  ACTION  DUE  SEARCHES*,/, 

(CA6a>  1*  (YES  OR  NO) */) 

^ (0A63)  READ(1,3) lOPT 

<0A6A>  IFdOPT.EQ.'NO*)  GOTO  111 

(0A65)  IF(IOPT.NE.*YE*)  GOTO  100 

(OASG)  Rrl 

(0A67)  111  IFCIDES.EG. *TI * > CALL  TITDW 

(0468)  IFdOES.EO.  *AL*)  CALL  ALDW 

(0469)  IF(IDES.EQ.*AC*)  CALL  ACTDUE 

(0470)  IF(IDES.EQ.*DR*)  CALL  DRAWN 

(0471)  IF(IDES.EO.*OA*)  CALL  DATDW 

(0472)  IFdDES.EQ.  *SY*  ) CALL  SYSDU 

(0473)  IFdDES.EQ. *VE*)  CALL  VEHNO 

(0474)  IFdDES.EQ. *SE*)  CALL  SECTN 

(C475)  IF (IDES.EQ. *CO* ) CALL  CODE 

(0476)  IFdDES.EQ.  *EO*  ) CALL  EONN 

(0477)  99  WRITEd,98) 

(0478)  98  FORHAK*  TO  CONTINUE,  DEPRESS  THE  RETURN  KEY*/) 

( 04  79)  REA0(1,9999  )IOES 

(0480)  IFdOES.NE.*  *)  GCTO  99 

(0481)  CALL  CLEAR 

(0482)  WRITEd,!) 

(0483)  REWIND  6 
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(04PA)  REWIND  12 

<0A95>  REWIND  18 

(0/)86)  GO  TO  6 

(0t87)  10  WRITE(lfll) 

(0-»£8>  11  FORMAT!*  00  YOU  WANT  A HARD  COPY  OF  THE  INFORMATION  FOUND»*/t 

(0A89)  1*  (YES  OR  NO)*) 

(0A90)  READ(1,3)  IDES 

(0A91)  IF(IDES.EQ.*YE*)  GO  TO  20 

(0492)  IF(IDES.EQ.*NO*)  GO  TO  15 

(0493)  • GO  TO  10 

(0494)  15  CALL  SRCH$$ ( KSCLOS , * OUT  *,6,0»0«0) 

(0495)  CALL  SRCHIJ (KJDELEt *OUT  *,6.0»0t0) 

(0496)  RETURN 

(0497)  20  CALL  SRCH $J ( K 1C  LOS « * OUT  *»6»0«0,0) 

(0498)  CALL  SRCH $1 ( KICLC S , *DR A W *»6»0*0»0) 

( 0499)  CALL  SRCHIKKICLOS,  *EO  *,6«0iC*0) 

(0500)  CALL  SRCHtl(K$CLOS.*SHEET  *»6,0,0«0) 

(OEOl)  CALL  COHIIK *S0UT*,4,12»IC) 

(0502)  CALL  EXIT 

(0503)  ENO 
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R 
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R 
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CODE 
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EXTERNAL 

000000 
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EXTERNAL 

000000 
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J 
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000000 
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000000 
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DT 
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I 

// 
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J 
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R 

EXTERNAL 

000000 
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J 
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EOREV 

I 
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EOVEH 

I 

// 
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0427S 

EPTIT 

J 
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ERDT 

I 

// 
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0427S 

ETIT 

J 

// 
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04275 

EXIT 

R 

EXTERNAL 

000000 
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J 

// 

000156 
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FIRST 

I 

// 

OOOA65 

04  2 7 5 

FNEQ 

I 

// 
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0427S 

."REV. 

I 

// 
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IC 

I 
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IDES 

I 

001150 
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0467 

0468 

04  71 

0 4 72 

0473 

0474 

0475 

0480 

0490M 

0491 

0492 

I DR 

J 

// 

000A52 

0427S 

INEO 

I 

// 

000A62 

0427S 

• 

I OPT 

I 

001151 

0429S 

0463M 

0464 

0465 

J 

I 

001152 

0433M 

0436 

KSALLO 

I 

PARAMETER 

042RS 

KSCACC 

I 

PARAMETER 

0428S 

KSCLOS 

I 

PARAMETER 

0428S 

0494 

0497 
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KSCONV 

I 

PARAMETER 

04  2SS 

KSCURR 

I 

PARAMETER 
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RSDELE 

I 

PARAMETER 
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I 

PARAMETER 
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ktndAk 

I 

PARAMETER 

0428S 
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KINRTN 

1 

parameter 

0428S 

ksnsAh 

I 

PARAMETER 

0428S 

VO 

KSNSGD 

I 

PARAMETER 

042SS 

Os 

KSNSGS 

I 

PARAMETER 

C42PS 

A 

\J 

KSPOSA 

I 

PARAMETER 

0428E 

KSPOSN 

I 

PARAMETER 

C428S 

KSFOSR 

I 

PARAMETER 

042SS 

KSPREA 

I 

PARAMETER 

042PS 

KiPRER 

I 

PARAMETER 

C4  2RS 

:<$PROT 

I 

PARAMETER 

C42P.S 
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PARAMETER 

0428S 
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I 

PARAMETER 

0428S 

K4RP0S 

I 

PARAMETER 

0 4 2 P S 

KiRSUD 

I 

PARAMETER 

0428S 

KSRULK 

1 

PARAMETER 

0428S 

KtSENT 
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.PARAMETER 
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PARAMETER 
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PARAMETER 
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I 
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I 

PARAMETER 
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000466 
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// 

000145 

0427S 

SECTN 

R 

EXTERNAL 

COOOOO 

0474 

SHTN 

I 

// 

000236 

0427S 

SRCH$$ 

R 

EXTERNAL 

000000 

0435 

0494 

0495 

SYS 

J 

// 

000133 

C427S 

SYSDW 

R 

EXTERNAL 

000000 

0472 

TIT 

J 

// 

000010 

0427S 

TITDU 

R 

EXTERNAL 

000000 
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J 

// 

000467 
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// 
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(0504) 

(0505) 

(0505) 

(0505) 

(0505) 

•(0505) 

(0505) 

(0505) 

(0505) 


0 

1 


(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0505) 

(0506) 

(0507) 

(0508) 

(0509) 

(0510) 

(0511) 

(0512) 

(0513) 

(0514) 

(0515) 

(0516) 

(0517) 

(0518) 

(0519) 

(0520) 

(0521) 

(0522) 

(0523) 

(0524) 


SUBROUTINE  EONN 
C 

C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

C 

COMMON  DRAU,TIT,PTIT*OT,SYStVEH,SECTfNSHTtFREV»FNEO.FEOREF» 

1 DRU«SHTN,REV,NE0,E0REF» 

1 EONtETITtCPTIT,EOREV,EDT«ERDT»EOVEH, 

1 R»IDR*INE0*KNT»FIRST, SECOND, TTIT 

C 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 

C 

INTEGER *4  PRAW(4),TIT(21) ,PTITtl9),SYS(3),SECT(3),FE0REF(10,2)  , 

1 DRW(4),EOREF(10,2),EPTIT(19),FTIT(21),EON(2)  , 

1 ICR  (4  ) ,KM  ,TTIT  (19) 

I NT  EGER *2  DT ( 3 ) , VC H ( 2, 2 ) , NSHT , SHTN ( 2 ) , FR E V , FNEO, R E V , NEO , 

1 EOREV,t DT (3) , ERDT( 3) ,FOVEH<2 ,2 ) ,R, INEO, 

1 FIRST, SECOND 

C 

c 

INTEGER*4  IE0N(2),KNTT 
INTEGER*2  ARR A Y ( 1 5 ) , I OPT 
C 

C THIS  ROUTINE  LOCATES  A SPECIFIED  E.O.  NUMBER  IN  THEE.O.  SUBFILE 

C. 

C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

IPAGE=0 

C INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 

ILINE=0 

C INITIALIZE  THE  FOUND  COUNTERS 

KNT  = 0 
KNTT=0 
CALL  CLEAR 

1 URITE(1,2)  . • ‘ 

2 FORMAT!*  WHAT  IS  THE  DESIRED  E.O.  NUMBER*) 

READ(1,3,ERR=1)IE0N 

3 F0RMAT(2A4) 

99  WRITE<1,1Q5> 

1C5  FORMAT! IX, *DO  YOU  DESIRE  T)!E  E.D.  FILE  SEARCH  (E0)*,/,3X, 
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(0525)  1»0R  ALL  DRAWINGS  USING  THIS  E.O.  (DR)*/) 

(0526)  READd.IlOf  ERR  = 99)  lOPT 

(0527)  110  F0RHAT(1A2) 

(0528)  IFdOPT.EO.  *E0*)  GOTO  260 

(0529)  IFdOPT.NE.’DR*)  GOTO  99 

(0530)  C INITIALIZE  FIRST  SHEET  FLAG 

(0531)  FIRST=0 

(0532)  C INITIALIZE  SECOND  OR  MORE  SHEET  FLAG 

(0533)  SECOND=0 

(0o34>  C INITIALIZE  THE  DRAW  DATA  PRINTED  FLAG 

(0535)  INEO=0 

(0536)  15  REAO(6,END=1005DRAlj,TIT,PTIT,DT,SYS,VEH,SECT»NSHT»FREV,FNEO»FEOREF 

(0537)  DO  2000  1=1,6 

(0538)  IF(IEON(  1)  .NE.FEOREFd,!)  ) GOTO  2000 

(0539)  IF(IEON(2).EQ.FEOREF(I,2))  GOTO  2050 

(0540)  2000  CONTINUE 

(0541)  GO  TO  18 

(0542)  C INCREMENT  THE  FOUND  COUNTERS 

(0543)  2050  KNT=KNT+1 

(0544)  KNTT=KNTT+1 

(0545)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(0546)  . ILINE=ILINE+FNE0+4 

(0547)  C CHECK  FOR  BOTTOM  OF  PAGE 

(0548)  IF(ILINE.LE.45>  GOTO  31 

(0549)  C SET  TO  TOP  OF. PRINTER  PAGE  FLAG 

(0550)  IPAGE=0 

(0551)  C SET  LINE  COUNTER  BACK  TO  0 

(0552)  ILINE=0 

(0553)  C IS  A HEADER  REQUIRED  NOW 

(0554  ) 31  IFdPAGE.NE.O)  GOTO  17 

(0555)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(0556)  ILINE=ILINE+12 

(0557)  C PRINT  HEADER  ON  PRINTER  OUTPUT  ' . I 

(0558)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(0559)  CALL  T I HD  AT ( ARR AY , 1 5 ) 

(0560)  AMIN  = ARRAY( 4 ) 

(0561)  AH=AHIN/60.0 

(0562)  IH=AH 
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(0563) 

(056A) 

(C565) 

(0566) 

(0567) 

(0568) 

(0569) 

(0570) 

(0571 ) 

(0572) 

(0573) 

(057A) 

(0575) 

(0576) 

(0577) 

(0578) 

(0579) 

(0580) 

(0581  ) 

(0582) 

(0583) 

(058A) 

(0585) 

(0536) 

(0587) 

(0588) 

(0589) 

(0590) 

( 0591  ) 
(0592) 
(0593) 

( 0599) 
(0595) 
(0596) 
(0597) 
(0598) 
(0599) 

( 0600  ) 


IHM=IH»60 

1KIN=AMIN 

IOM=IMIN-IMM 

URITE(7,8008) IH,IDM, (ARRAY( I) ,1=1,3) 

8008  FORMAT(M*,100X,I3,»;*,I3,9X,2(A2, •/*) ,A2) 

URITE(7,8000) 

8000  FORMAT(3X,120(*»*) ) 

UR1TE(7,8001) lEON 

8001  FORHATCAOX, 'ORAWING  - E.O.  NUMBER  SEARCH  •»2A9) 

• CALL  HEADER 

C SET  HEADER  DONE  FLAG 

IPAGE=1 

C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

17  FIRST=1 
CALL  HAIND 

18  IF  (NSHT.GT.l ) GOTO  19 
F1RST=0 

GO  TO  15 

19  CONTINUE 

DO  150  J=2,NSHT 

20  RFAD(12,END=1001)DRU,SHTN,REV,NEO,EOREF 
DO  25  K=l,9 

IF (DRW(K) .NE .DRAU(K) ) GOTO  20 
25  CONTINUE 

DO  2500  1=1,6 

IF(IEONd)  .NE.EOREFd,!)  ) GOTO  2500 
IF( IE0N(2) .EQ.EOREF (1,2)  ) GOTO  2550 
2500  CONTINUE 

GO  TO  150 
2550  SECOND=l 

C INCREMENT  THE  FOUND  COUNTER 

95  IF(FIRST.EO.O)  KNT=KNT+1 

KNTT=KNTT+1 

C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

ILINE=ILINE+NE0+9 
C CHECK  FOR  BOTTOM  OF  PAGE 

IF(ILINE.LE.95)  GOTO  32 
C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 


SUBROUTINE  EONN 


PAGE  0043 


(0601)  IPAGE=0 

(0602)  C SET  LINE  COUNTER  BACK  TO  0 

(U603)  ILINE=0 

((■604)  C IS  A HEADER  REQUIRED  NOW 

(0605)  32  IF(IPAGE.NE.O)  GOTO  50 

(0606)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(0607)  ILINE=ILINE+12 

(0638)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

(06U9)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(0610)  CALL  TIKOAT <ARRAY»15) 

(0611)  AMIN=ARRAY( 4) 

(0612)  AH=AKlN/60.0 

(0613)  IH=AH 

(0614)  IMH=IH*60 

(0615)  IMIN=ANIN  . 

(0616)  ID.M  = IKIN-IKH 

/ , I (0617)  URITE(7,fi008)lH»IDM,(ARRAY(I),I  = lt3) 

(0618)  URITE(7tB000  ) 

(0619)  WRITE(7,8Q01)  lEON 

(0620)  CALL  HEADER 

(0621)  C SET  HEADER  DONE  FLAG 

(0622)  IPAGE=1 

(0623)  C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

(0624)  50  CALL  MAIND 

(0625)  150  CONTINUE 

(0626)  FIRST=0 

(0627)  SECOND=0 

(0628)  INEO=0 

(0629)  GO  TO  15 

(0630)  1001  WRITE( 1»1002) 

(0631)  1002  FORMAT(*  AN  ERROR  HAS  OCURRED  DURING  DATA  SEARCH*) 

(0632)  RETURN 

(0633)  100  WRITE(1»200)KNT,KNTT»IEON 

(0634)  200  FORMATdX, ’THERE  ARE  *»I9,*  DRAWINGS  WITH  A TOTAL  OF  *»I9»/» 

(0635)  1*  SHEET(S)  IN  THE  DRAWING  SUBFILE  WHICH  REFERENCES  E.O.  *«2A4) 

(0636)  RETURN 

(0637)  260  READ( 18fEND  = 350  ) EON ,ET I T , EPT I T ,E ORE V*ED T,E RDT ,E OVEH 

(0633)  DO  266  I=lt2 


* I * * 
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0639) 

0640)  266 

0641) 

0642) 

0643)  C 

0644) 

0645) 

0 646) 

0647) 

0642) 

0649) 

0650) 

0651  ) 


!0652) 

!0£53) 

1000 

!0n54) 

300 

o 

!0655) 

!0656) 

!0657) 

302 

!0658) 

130 

!0659> 
!066C> 
!0661  ) 
!0662) 
!0663) 

230 

!0664) 

140 

!0665> 

!0666) 

!0667> 

!0f,68) 

250 

!0669> 

60 

!0670) 

!0671) 

!0672) 

!0673) 

!0674) 

350 

! 0675) 

360 

!0676) 

400 

IF(  lEON(I)  .NE.EONd  ) ) GOTO  260 

CONTINUE 

KNT=KNT+1 

IF(IPAGE.NE.O)  GOTO  302 

FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 
CALL  TIMDAT<ARRAY,15) 

AHIN=ARRAY(4) 

AH=AMIN/60.0 
IH  = AH 
IMM=IH*60 
IHIN=AHIN 
IDH=IHIN-IHH 

URITE(7tlOOO ) IHt IDHt ( ARRAY! I) ,I=1»3) 

FORMAT  (MdlOOX,  13,  »:»,  I3,4X,2(  A2t  »/•>,  A2)  ’ 

URITE(7,300) 

FORMAT(4X,115( •*»),/, SOX, *E.O.  SEARCH  »,/, 

19X,  'E.O.  NUMBER ',8 X, ‘DATE*, 6X, ‘E.O.  T ITLE • ,/ , 4 X, 11 5 ( • * ♦ ) , /, 1 HO ) 
IPAGE=1 
CONTINUE 
F0RHAT(3X,19A4) 

IF(EOREV.EQ.»NC»)  GOTO  250 
URITE(7,230) KNT,EON,EOREV,ERDT,EPTIT 

F0RMAT(1X,I4,*.  • , 2 A4 , 1 X , • RE V ♦ , A2 , 3 X ,2 ( 12 , •- » ) , 12  , 

13X.19A4,/) 

WRITE(1,140)  KNT,E0N,E0REV,ERDT,<(E0VEH(I,J),J=1,2),I=1,2) 
F0RHAT(2X,I4,*.»,2X,2A4,1X,*REV  •,A2,5X,2(I2,*-»),I2,3X,2(2X, 

1 13, AD) 

GO  TO  60 

WRITE(7,230)KNT,EON,EOREV,EDT,EPTIT 

URITE(1,140)  KNT,E0N,Fnr<EV,EDT,C(E0VEH{I,J),J=l,2),I=l,2) 
CONTINUE 

IF<EPTIT(1).NE.’  •)  WRITE(1,130)EPTIT 
IF(KNT/21.EQ.KNT/21.)  IPAGE=0 
CALL  PAUS 
GO  TO  400 
URITE(1,360)IEON 

FORMAT!*  THERE  IS  NO  E . 0 . ♦ , 1 X, 2A 4 , • IN  THE  EO  SUBFILE*,/) 

RETURN 
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AH 

R 

002233 

0561M 

0562 

0612M 

0613 

0646H 

0647 

AMIN 

R 

002235 

0560H 

0561 

0564 

0611M 

0612 

0615 

0645H 

0646 

0649 

ARRAY 

I 

000002 

0507S 

0559A 

0560 

0566 

0610A 

0611 

0617 

0644A 

0645 

0651 

CLEAR 

R 

EXTERNAL 

000000 

0518 

DRAW 

J 

// 

000000 

0505S 

0536H 

0585 

JRU 

J 

// 

00022G 

0505S 

0583M 

Oiiftb 

DT 

I 

// 

000130 

05055 

0536M 

EOT 

I 

// 

000437 

05055 

0637M 

0667 

0668 

EON 

J 

// 

000312 

0505S 

0637M 

0639 

0660 

0663 

0667 

0668 

EONN 

R 

OOOOOO 

0504S 

EOREF 

J 

// 

OC0242 

0505S 

0583H 

0588 

0589 

EOREV 

I 

// 

000436 

05055 

0637M 

0659 

0660 

0663 

0667 

0668 

EOVEH 

I 

// 

000445 

0505S 

0637M 

0663 

0668 

EPTIT 

J 

// 

000370 

0505S 

0637M 

066  0 

0667 

0670 

EROT 

I 

// 

000442 

0505S 

0637M 

0660 

0663 

ETIT 

J 

// 

000316 

0505S 

C637M 

FEOREF 

J 

// 

000156 

0505S 

C536M 

0538 

0539 

FIRST 

I 

// 

000465 

0505S 

0531M 

0576M 

0579M 

0594 

0626K 

FNEO 

I 

// 

000155 

05055 

0536K 

0546 

FREV 

I 

// 

000154 

05055 

0536M 

HEADER 

R 

EXTERNAL 

000000 

0572 

0620 

I 

.1 

002237 

0537H 

0538 

0539 

0566H 

0587M 

0588 

0589 

0617M 

063SH 

0639 

0651M 

0663H 

0658M 

I DM 

I 

002241 

0565H 

0566 

0616H 

0617 

0650M 

0651 

IDR 

J 

// 

000452 

05055 

lEON 

J 

000021 

05065 

0521H 

0538 

0539 

0570 

0583 

0589 

0619 

0633 

0639 

0674 

IH 

I 

002242 

0562M 

0563 

0566 

0613H 

0*614 

0617 

0647M 

0648 

0651 

ILINE 

I 

002243 

0514M 

0546H 

0548 

0552H 

0556M 

• 0597M 

0599 

0603M 

0607H 

■ 

IMIN 

I 

002244 

0564M 

0565 

0615M 

0616 

0649H 

0650 

IMH' 

I 

002245 

0563M 

0565 

061  4M 

0616 

0648M 

0650 

INEO 

I 

// 

000462 

05055 

0535M 

062fiM 

lOPT 

I 

002246 

05075 

C526H 

0528 

0529  . 

IPAGE 

I 

002247 

0512M 

0550M 

0554 

0574M 

Q601K 

0605 

0622K 
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0642 

0656P 

0671M 

J 

I 

002250 

0582K 

0663M 

C668M 

K 

I 

002251 

0584H 

0585 

KNT 

J 

// 

00CA63 

0505S 

0 5 1 6 M 

0543M 

0594H 

0633 

0641H  0660 

0663 

0667 

0668 

0671 

KNTT 

J 

002252 

050f.S 

0517H 

C544M  ■ 

0595H 

0633 

HAINO 

I 

EXTERNAL 

000000 

0577 

0624 

NEO 

I 

// 

0002A1 

05C5S 

0583M 

0597 

NSHT 

I 

n 

000153 

0505S 

0536M 

0578 

0582 

PAUS 

R 

EXTERNAL 

000000 

0672 

PT.IT 

J 

// 

000062 

0505S 

0536M 

R 

I 

// 

000A51 

0505S 

REV 

I 

// 

0002A0 

05C5S 

0583M 

SECOND 

I 

// 

000A66 

0505S 

0533M 

0592H 

0627H 

SECT 

J 

// 

0C01A5 

0505S 

0536M 

SHTN 

I 

// 

000236 

0505S 

0583M 

SYS 

J 

U 

000133 

0505S 

053&H 

TIHDAT 

R 

EXTERNAL 

000000 

0559 

0610 

0644 

TIT 

J 

// 

000010 

0505S 

0536H 

TTIT 

J 

// 

OOOA67 

0505S 

VEH 

I 

// 

OOOlAl 

05C5S 

0536N 

000042 

0515D 

0521 

_100 

001166 

0536 

0633D 

_1000 

001471 

0651 

0652D 

_1001 

001131 

• 0533 

0630D 

_1002 

001135 

0630 

0631D 

105 

000113 

0523- 

0524D 

000205 

0526 

0527D 

_130 

001605 

06580 

0670 

lAO 

001755 

0663 

0664D 

0668 

-15 

000232 

0536D 

0580 

0629 

150 

001 115 

0582 

0591 

0625D 

_17 

000572 

0554 

0576D 

18 

000575 

0541 

0578D 

000606 

0578 

0581D 

000047 

0519 

0520D 

_20 

000612 

05R3D 

0585 
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_2  0 0 

001204 

0633 

0634D 

_2  0 0 0 

000335 

0537 

0538 

05400 

~2050 

000343 

0539 

05430 

230 

001644 

0660 

06610 

0667 

_25 

000663 

0584 

05860 

_250 

002016 

0659 

C667D 

2500 

000724 

0587 

0588 

05900 

12550 

000733 

0589 

05920 

_260 

001301 

0528 

06370 

0639 

266  • 

001357 

0638 

06400 

~3 

000103 

0521 

05220 

_300 

001520 

0653 

06540 

302 

001605 

06  4 2 

06570 

l31 

000374 

0548 

05540 

_-'>2 

001000 

05^9 

06050 

_350 

002160 

0637 

06740 

_360 

002167 

0674 

06750 

400 

002222 

0673 

06760 

~4  5 

000736 

0594D 

Iso 

001114 

0605 

06240 

60 

002110 

0666 

06690 

_8000 

000521 

0568 

05690 

0618 

Isool 

000540 

0570 

05710 

0619 

8008 

000472 

0566 

05670 

0617 

~99 

000107 

0523U 

0526 

0529 

0000  ERRORS  KEONN  >FTN-REV14. 2 I 
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(0o78)  SUBROUTINE  TITDW 

(0079)  C 

(0679)  C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

(0679)  C 

(0679)  COMMON  DR AW , TI T tPTI T t DT , S YS , VEH ,S ECT » NSHT. FRE V f FNEO » FEOREF » 

(0679)  1 DRW,SHTN,REV,NEO.EOREF, 

(0679)  1 EON,ETIT.EPTIT,EOREV,EDTfERDTtEOVEH» 

(0679)  I R, IDR, INEO,KNT»FIRST»SECONDtTTIT 

(0679)  C 

(0679)  C DATA  DECLARATION  BLOCK  FOR  THE  ORAU-EO  FILE 

(0679)  C 

(0679)  INT£GER*A  DR  AW  ( A ) , T I T ( 2 1 ) , PT IT ( 19 ) t S YS ( 3 ) , SECT ( 3 ) »FE OREF( 1 0 » 2 ) . 

(0679)  1 DRW(A),E0REF(10,2)«EPTIT(19).ETIT(21),ECN(2)* 

(0679)  1 IDR(A),KNT,TTIT(19) 

(0679)  INTEGER*2  DT ( 3 ) ,V EH ( 2 * 2 ) tMSHT  , SHTN ( 2 ) ,FREV » FNEO t RE V » NEO t 

(0679)  1 EOREV,EDT(3),ERDT(3)*EOVEH(2»2)tR»INEO* 

(0679)  1 FIRST.SECOND 

(0679)  C 
(0679)  C 

(0680)  C SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY.  1977 

(0680)  NOLIST 

(0681)  C 

(0682)  C 

(0683)  C THIS  IS  THE  TITLE  SEARCH  ROUTINE  FOR . THE  DR AWI NG  FILE 
(C68A)  t 

(0685)  INTEGER*^  IT(21),IEX(A,3),BLNK 

(0686)  INTEGER*2  D OC . T1 , 1 N , ICON , 1 0 , I OPT , I L I NE . I PAGE. I C . I T Y . ARR A Y ( 15 ) 

(0687)  T1=0 

(0688)  C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

(0689)  IPAGE=0  * 

(0690)  C INTIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 

(0691)  ILINE=0  . • 

(0692)  c FILL  Extra  title  with  blanks  . ' 

(0693)  99  DO  8003  1=1. A ' 

(069A)  DO  800A  J=1.3 

(0695)  IEX(I.J)=»  * 

(0696)  800A  CONTINUE  . 

(0697)  8003  CONTINUE 
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(0698) 

(0699) 

(0700) 

(0701) 

(0702) 

(0703) 

(070A) 

(0705) 

(0706) 

(0707) 

(0708) 

(C709) 

(0710) 

(0711) 

(0712) 

(0713) 

(0714) 

(0715) 

(0716) 

(0717) 

(0718) 

(0719) 

(0720) 

(0721) 

(0722) 

(0723) 

(0724) 

(0725) 

(07265 

(0727) 

(0728) 

(0729) 

(0730) 

(0731) 

(0732) 

(0733) 

(0734) 

(0735) 


CALL  CLEAR 
1001  URITE(lt2) 

2 FORHATC  HOW  MANY  WORDS  DO  YOU  WISH  TO  HATCH  (MAX  OF  4)»t/ 

1/) 

READ(l,8tERR=1001)ICON 
8 FORHAT(I2) 

IF(ICON.LT.l)  GO  TO  1001 

IF(ICON.GT.4 ) GO  TO  1001 

DO  1000  LOOP=1,ICON 
URITE(lfl) 

, 1 FORHAT(»  WHAT  IS  THE  DESIRED  WORD*»//) 

LEN=10 

CALL  TINPUTdTiLEN) 

IF(IT(1).EG.*QUIT*)  GO  TO  1002 

CALL  SRCH$i(K$RDU'R-*K$NDAK»»Tl  »t6»9tltIC) 

CALL  SRCH1J(K$RDUR+K$N0AH»»T2  ♦♦6»10»1»IC) 

C SAVE  WORD  OF  TITLE  SEARCH 

DO  8006  K=l,3 
IEX(LOOP,K)=IT(K) 

8006  CONTINUE 

IF(Tl.EO.O)  IN=6 
IF(Tl.EQ.O)  10=13 
IF(Tl.EQ.l)  IN=13 
IF  (T1.E3. 1)10=14 
IF(T1.E0.2)  IN=14 
IF(T1.EQ.2)  10=13 
IF(T1.EQ.3)  IN=13 
IF(T1.EQ.3)  10=14 
IF(T1.EQ.4)  IN=14 
IF(T1.EG.4)  10=13 
DOC  = 0 
REWIND  IN 
REWIND  10 

5 READ(IN,END=100)ORAW,TIT ,PTIT,DT»SYS»VEH,SECT,NSHTfFREV»FNEO. 

1 FEOREF 

BLNK=»  * 

DO  3 I=l»21 

IF(TIT(I).EQ.BLNK)  GO  TO  3 


370 


SUBROUTINE  TITDW 


PAGE  DObO 


0 

1 

CJl 


(0736) 

(0737) 

(0738) 

(0739) 

(07A0) 

3 

(D7A1) 

( 07A2) 

A 

( 07A3) 

(07AA) 

(07A5) 

•10 

(07A6) 

(07A7) 

100 

(07A8) 

1030 

(07A9) 

(0750) 

(0751) 

(0752) 

(0753) 

(075A) 

(0755) 

(0756) 

(0757) 

1000 

(0758) 

1002 

(0759) 

(0760) 

(0761) 

(0762) 

(0763) 

(076A) 

C 

(0765) 

(0766) 

c 

(0767) 

(0768)  C 
(0769) 
(0770)  C 
(0771  ) 
(0772)  C 
(0773) 


1F(TIT(I).NE.IT(1))  GO  TO  3 

IF(TIT( I+l) .EQ.BLNK)  GO  TO  A 

IF( IT(2).EQ.BLNK)  GO  TO  A 

IF(TIT( I+l) .EQ.IT (2 ) ) GO  TO  A 

CONTINUE 

GO  TO  5 

DOC=DOC*1 

WRITE(IO) DRAU,TIT»PTIT,DT*SYStVEH,SECTtNSHT,FREV»FNEOfFEOREF 
URITC(1»10)TIT 
F0RMAT(7(1X,2AA,A2)) 

GO  TO  5 

URITE(1»1030)OOC«IT 

FORMAT!*  THERE  ARE*»I5«»  DRAWINGS  CONTAINING  THE  WORO*i/ 
17(1X,2AA,A2)//) 

IF(DOC.EQ.O)  GOTO  1020 
ENDFILE  10 

CALL  SRCHS$(KSCL0S, *T1  ’iG^O^OtO) 

CALL  SRCHS$(KSCL0S,»T2  *.6*0»0*0) 

IF(IO.EQ.13)  CALL  SR CH$$ ( KSDELE » * T2  *.6, 0*0*0) 

IF(IO.EQ.IA)  CALL  SRCHS I ( K SDCLE , * T1  **6*0*0*0) 

T1=T1+1 

CONTINUE 

CALL  SRCH$$(K$RDUR+K$NDAH* *T1  **6*9*1*10  • 

CALL  SRCH$$(K$RDWR+KJNDAM,*T2  **6*10*1*10 

IF(DOC.LT.l)  GO  TO  1020 
DO  9999  I=1*D0C 

READ(IO*END=1020)DRAU*TIT*PTIT,DT*SYS*VEH,SECT*NSHT*FREV*FNEO* 
1 FEOREF 

GET  RECORD  NUMBER 
KNT  = I 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 
ILINE=ILINE+FNE0+NSHT+3 
CHECK  FOR  BOTTOM  OF  PAGE 
IFdLINE.LE.A5)  GOTO  31 
SET  TO  TOP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

SET  LINE  COUNTER  BACK  TO  0 
ILINE=0 
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(0774) 

C 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(0775) 

ILINE=FNEO*NSHT+3 

(0776) 

C 

IS  A HEADER  REQUIRED  NOW 

(0777) 

31 

IF(IPAGE.NE.O)  GOTO  150 

(0778) 

C 

INCREMENT  LINE  COUNTER  FOR  HEADER 

(0779) 

ILINE=ILINE+12 

(0780  ) 

C 

PRINT  HEADER  ON  PRINTER  OUTPUT 

(0781  ) 

C 

FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(0782) 

CALL  TIHD AT (ARRAY, 15) 

(0783) 

AM1N=ARRA Y(4) 

(0784) 

AH=AMIN/60.0 

(0785) 

IH  = AH 

(0786) 

IMM=IH*60 

(0787) 

IMIN=AMIN 

(0788) 

IDH=IMIN-IMM 

(0789). 

URITE(7,8008) IH, IOH,(ARRAY( J) ,J=1,3) 

O 

(0790  ) 

8008 

FORMAT (•!»,  100 X,  13,*: ♦, I3,4X,2(A2,*/») ,A2) 

1 

cn 

(0791) 

WRITE(7,8000) 

U) 

(0792) 

8000 

FORMAT(3X,120(**»)  ) 

(0793) 

WRITE (7, 80 01)  (( IEX(K,L)  ,L  = 1,3) ,K  = 1,4) 

(0794) 

8001 

F0RHAT(43X, 'DRAWING  TITLE  SEARCH  : » , 4 ( 1 X, 2 A4  , A2 ) ) 

(0795)  CALL  HEADER 

(0796)  C SET  HEADER  DONE  FLAG 

(0797)  . IPAGE=1 

(0798)  C DISPLAY  AND  PRINT  HEADING  ON  TERMINAL  AND  PRINTER  OUTPUT 

(0799)  150  CALL  DMAIN 

(0800)  C INCREMENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

(0301)  ILINE=ILINE+INEO 

(0802)  C IS  PRINTER  AT  BOTTOM  OF  PAGE 

(0803)  IF(  ILINE.LE.A5)  GOTO  9999 

(0804)  C SET  TOP  OF  PRINTER  PAGE  FLAG 

(0805)  IPAGE=0 

(0P06)  C RESET  THE  LINE  COUNTER  FOR  NEW  PAGE 

(0807)  ILINE=0 

(0808)  9999  CONTINUE 

(0809)  1020  CONTINUE 

(0810)  CALL  SRCH$S(K$CLOS, *T1  NGtOfOtO) 

(0811)  CALL  SRCHIKKJCLOSt  *T2  »»6«0»0»0) 
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<0812)  CALL  SRCHSJ <KJDELE» »T1  •♦6»0»0»0) 

(0813)  CALL  SRCHIS(K$DELE» *T2  **6»0»0»0) 

(0814)  T1=0 

(0815)  IF(DOC.NE.O)  RETURN 

(0816)  1999  URITEd  t2000) 

(0817)  2000  FORHAT(»  DO  YOU  WISH  TO  TRY  THE  TITLE  SEARCH  AGAIN 

(0818)  READ(l»200l»ERR=1999)IOPT 

(0819)  2001  F0RHAT(1A2) 

(0820)  IF(IOPT.Ea.*YE»)  GOTO  99  . 

(0821  ) IFdOPT.NE.'NO*)  GOTO  1999 

(0822)  RETURN 

(0823)  END 
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(YES  OR  NO)*) 


,).  ■ „ ) 
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AH 

R 

C016A7 

0784M 

0785 

AMIN 

R 

001651 

0783H 

0784 

0787 

ARRAY 

I 

000002 

0686S 

0782A 

0783 

0789 

. BLNK, 

J 

001653 

0685S 

0733M 

0735 

0737 

0738 

CLEAR 

R 

EXTERNAL 

000000 

0698 

DMAIN 

R 

EXTERNAL 

000000 

0799 

DOC 

I 

001655 

0686S 

0728H 

0742M 

0747 

0750 

0760 

0 761 

0815 

DRAW 

J 

// 

000000 

0675S 

0731M 

0743 

0762H 

DRW 

J 

// 

000225 

0679S 

DT 

I 

// 

000130 

0679S 

0731H 

0743 

0762M 

EOT 

I 

n 

000 A37 

0679S 

EON 

J 

// 

000312 

0679S 

EOREF 

J 

// 

000242 

0679S 

EOREV 

I 

// 

000436 

0679S 

EOVEH 

I 

// 

000445 

0679S 

0 

1 

EPTIT 

J 

n 

000370 

C679S 

cn 

/ n 

ERDT 

I 

n 

000442 

0679S 

ETIT 

J 

// 

000316 

C679S 

FEOREF 

J 

// 

000156 

0679S 

0731H 

0743 

0762H 

FIRST 

I 

// 

000465 

0679S 

FNEO 

I 

// 

000155 

0579S 

073.1H 

0743 

0762H 

0767 

0775 

FREV 

I 

u 

000154 

0679S 

0731K 

0743 

0762M 

• 

HEADER 

R 

EXTERNAL 

oooooo 

0795 

I 

I 

001656 

0693H 

0695 

•0734H 

0735 

0736 

0737 

0739 

0761M 

0765 

IC 

I 

001660 

C686S 

0712A 

0713A 

0758A 

0759A 

ICON 

I 

001661 

0686S 

0702H 

0704 

0705 

0706 

IDH 

I 

001662 

07  88M 

0789 

IDR 

J 

// 

000452 

0679S 

lEX 

J 

000021 

0685S 

0695H 

0716H 

0793 

IH 

I 

001663 

0785H 

0786 

0789 

ILINE 

I 

001664 

0686S 

0691H 

0767H 

0769 

0773M 

0775M 

0779H 

0801H 

0803 

0807M 

IHIN 

I 

001665 

0787M 

0788 

IHM 

I 

001666 

0786H 

0788 

IN 

I 

001667 

0636S 

0718M 

0720H 

0722H 

0724H 

0726H 

0729 

0731 
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INEO 

I 

//  000A62 

0679S 

0801 

10 

I 

001670 

06B6S 

0719M 

0721M 

0723M 

0725M 

0727M 

07A3 

0751 

0759 

0755 

0762 

lOPT 

I 

001671 

0686S 

0818M 

0820 

0821 

IPASE 

I 

001672 

C686S 

0689M 

0771M 

0777 

0797M 

0805M 

IT 

J 

000051 

0685S 

0710A 

0711 

0716 

0736 

0738 

07A7 

ITY 

I 

000000 

0686S 

J 

I 

001673 

069AM 

0695 

C7S9M 

K 

I 

00167A 

071  5M 

0716 

0793H 

KSALLD 

I 

PARAMETER 

C680S 

KSCACC 

I 

PARAMETER 

0680S 

KICLOS 

I 

PARAMETER 

C680S 

0752 

0753 

0810 

0811 

KSCONV 

I 

PARAMETER 

0680S 

KSCURR 

I 

parameter 

0680S 

KSDELE 

I 

PARAMETER 

C68CS 

075a’ 

0755 

0812 

0813 

KSDMPB 

I 

parameter 

0680S 

KSDTIM 

I 

parameter 

06E0S 

XSENTR 

I 

000000 

0 6 8 0 S 

KSEXST 

I 

PARAMETER 

0680S 

KSGOND 

I 

PARAMETER 

0680S 

KSGPOS 

I 

PARAMETER 

0680S 

KSHOME 

I 

PARAMETER 

068DS 

KSICUR 

I 

PARAMETER 

06SOS 

KSIHFD 

I 

PARAMETER 

0680S 

KSIRTN 

I 

PARAMETER 

0680S 

KSISEG 

I 

PARAMETER 

0680S 

KSIUFD 

I 

PARAMETER 

C680S 

KiMENT 

I 

000000 

0680S 

KSMSIZ 

I 

PARAMETER 

06QCS 

• 

KSHVNT 

I 

PARAMETER 

068  0 5 

KSNDAM 

I 

PARAMETER 

0660S 

0712 

0713 

0758 

0759  • 

KSNRTN 

I 

PARAMETER 

C680S 

, 

KSNSAH 

1 

PARAMETER 

06805 

KSNSGD 

I 

PARAMETER 

0680S 

KSNSGS 

I 

PARAMETER 

06805 

KSPOSA 

I 

PARAMETER 

06805 

KSPOSN 

I 

PARAMETER 

06805 

0730 


0739 
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O 

^ cn 


\i 


KSPOSR 

1 

PARAMETER 

0680S 

KIPREA 

I 

PARAMETER 

0680S 

KSPP.ER 

I 

PARAMETER 

0680S 

KSPROT 

I 

PARAMETER 

0680S 

KSRDUR 

I 

PARAMETER 

068DS 

0712 

0713 

0758 

0759 

KSREAD 

I 

PARAMETER 

0680S 

KSRPOS 

I 

PARAMETER 

0680S 

KSRSUe 

I 

PARAMETER 

068CS 

KSRULK 

T 

X 

PARAMETER 

0680S 

KtSENT 

I 

000000 

0680S 

KSSETC 

I 

PARAMETER 

06SOS 

KJSETH 

I 

PARAMETER 

0680S 

KSSPOS 

I 

PARAMETER 

0630S 

KSSRTN 

I 

PARAMETER 

068CS 

KSTRNC 

I 

PARAMETER 

0680S 

KtUF'OS 

I 

0 ARAMETER 

0680S 

K$UR  IT 

I 

PARAMETER 

0680S 

KNT 

J 

//  000463 

0679S 

0765M 

L 

I 

001675 

0793M 

LEN 

I 

001676 

070PH 

0710A 

LOOP 

■I 

001677 

0706M 

0716 

NEO 

I 

//  000241 

0679S 

NSHT 

I 

/•/  0 00153 

0679S 

0731H 

0743 

0762M 

0767 

0775 

PTIT 

J 

//  000062 

C679S 

0731H 

0743 

0762M 

R 

I 

//  000451 

0679S 

REV 

I 

//  000240 

0679S 

SECOND 

I 

//  000466 

0679S 

SECT 

J 

//  000145 

0679S 

0 731M 

0743 

0762H 

SHTN 

I 

//  000236 

0679S 

SRCHIJ 

R 

EXTERNAL  000000 

0712 

0713 

0752 

0753 

0754 

0755 

0758 

0759 

0810 

0811 

0812 

0813 

SYS 

J 

//  000133 

0679S 

0731M 

0743 

0762M 

T1 

1 

001700 

0685S 

0687M 

0718 

0719 

0720 

0721 

0722 

0723 

0724 

0725 

0726 

0727 

0756H 

0814H 

000000  0782 

000000  0710 

000010  0679S  0731M  0735  0736  0737  0739  0743 

0744  0762H 


TIHDAT  R EXTERNAL 
TINPUT  R EXTERNAL 
TIT  J // 
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TITOU  R 

000000 

0678S 

TTIT  J // 

000A67 

0679S 

VEH  I // 

OOOlAl 

0679S 

0731M 

0743 

0762M 

_1 

000265 

0707 

07080 

liO 

000716 

0744 

07450 

_10  0 

000727 

0731 

07470 

1000 

001066 

0706 

07570 

_1001 

000170 

0699D 

0702 

0704 

0705 

_1002  . 

001076 

0711 

07580 

Il020 

001500 

0750 

0760 

0762 

08090 

_1030 

000741 

0747 

07480 

_150 

001457 

0777 

07990 

,.1999 

001551 

08160 

0818 

0821 

_2 

000175 

0699 

07000 

~2000 

001556 

0816 

08170 

o 

..2001 

001625 

0818 

08190 

J3 

000631 

0734 

0735 

0736 

07400 

_31 

001227 

0769 

07770 

000640 

0737 

0738 

0739 

0742D 

Is 

000501  ' 

07310 

0741 

0746 

_8 

000242 

0702 

07030 

_8000 

001354 

0791 

07920 

_8001 

001424 

0793 

07940 

_8  003 

000160 

0695 

06970 

■ ~8  C 0 A 

000151 

0694 

06960 

8006 

000365 

0715 

07170 

_8008 

001325 

0789 

07900 

_99 

000132 

06930 

CB20 

_9999 

001472 

0761 

0 80  3 

08080 
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(0824) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0825) 

(0325) 

(0825) 

(0825) 

(0825) 

(0825) 

(0826) 

(0326) 

(0827) 

(0828) 

(0829) 

(0830) 

(0831) 

(0832) 

(0833) 

(0834) 

(0835) 

(0836) 

(0837) 

(0858) 

(0839) 

(0840) 

(0841) 

(0842) 

(0843) 


SUBROUTINE  ACTDUE 
C 

C COMMON  BLOCK  FOR  THE  ORAW-EO  FILE 

C 

COMMON  DRAW ,T IT  »? T I T , DT ,S YS * V EH *S ECT tNSHT « FR EV ,FNEO » FEOREF  « 
1 DRW,SHTN,REV»NEO»EOREF, 

1 t:ON,ETIT,EPTIT,EOREV,EDT«ERDT,EOVEH» 

1 R* IDR*INEOf KNT,FIRETtSECOND*TTIT 

C 

C DATA  DECLARATION  SLOCK  FOR  THE  ORAW-EO  FILE 

C 

INTEGER*4 

1 
1 

INTEGER*2 

1 
1 
C 
C 

C SYSCOM>KEYS.F 
NOLIST 
INTEGER»4 
INTEGER*2 
C 
C 

C THIS  SUBROUTINE  PERFORMS  CHECKS  ON  ALL  DRAWINGS  HAVING 

C FIVE  (5)  OR  MORE  E.O.’S 

C 

C INITIALIZE  FIRST  SHEET  FLAG 

FIRST=0 

C INITIALIZE  SECOND  OR  MORE  SHEET  FLAG 

SEC0ND=0 

C INITIALIZE  THE  DRAW  DATA  PRINTED  FLAG 

INE0=0 

C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

IPAGE=0 

C INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 

ILINE=0 


DRAW(4) ,TIT(21) »PTIT(19) ,SYS(3) ,SECT(3) *FEOREF(10»2)  , 

DRW(4),ECREF(10,2),EPTIT(19)tETIT(21),EON(2)» 

IDR(4),KNT,TTIT(19) 

DT(3) .VEH(2t2) iNSHTtSHTN(2) «FREV,FNEO,REV»NEOt  . 
E0REV,EDT(3),ER0T(3),E0VEH(2,2)*R»INE0» 

FIRST,SECOND 
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KNTT 

IPAGE*ILINE»ARRAY(15) 
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:00AA)  C INITIALIZE  THE  FOUND  COUNTERS 

:08A5)  KNT=0 

08A6)  KNTT=0 

08A7)  CALL  BREAKS! .TRUE. > 

:08AS)  URITEd  »1  ) 

08A9)  1 FORMAT!’  THIS  IS  THE  REVISION  ACTION  DUE  SEARCH  ROUTINE. »t/, 

0850) '  1»  ALL  DRAWINGS  WITH  FIVE  !5)  OR  MORE  E.O.”S  ARE  FOUND  AND 

0851)  I’SPOOLEO.’) 

0852)  15  READ!6,END=100)DRAW,TIT,PTIT,DT»SYS»VEH,SECT»NSHT,FREV»FNEO*FEOREF 

0853)  IF!FNE0.LT.5)  GOTO  18 

OeSA)  C INCREMENT  THE  FOUND  COUNTER 

0855)  KNT=KNT+1 

0856)  KNTT=KNTT+1 

0857)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

0858)  ILINE=ILINE+FNEO+4 

0859)  C CHECK  FOR  BOTTOM  OF  PAGE 

0860)  IF!ILINE.LE.A5)  GOTO  31 

0861)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

0862)  IPAGE=0 

0863)  C SET  LINE  COUNTER  BACK  TO  0 

086A)  ILINE=0 

0865)  C IS  A HEADER  REQUIRED  NOW 

0866)  31  IFIIPAGE.NE.O)  GOTO  17 

0867)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

0868)  ILINE=ILINE*12 

0869)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

0870)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

0871)  CALL  TIMOAT!ARRAY,15) 

0872)  AMIN=ARRAY!A) 

0873)  AH=AMIN/60.0 

087A)  IH=AH 

0875)  IMM=IH*60 

0876)  IMINrAMIN 

0377)  IDH=IMIN-IMM 

0«78)  WRITE!7,80U8)IHfIDM,!ARRAY!I),I=lf3) 

0879)  8008  FORHAT!*1»,100X,I3,»:’,I3,AX,2!A2,’/’),A2) 

0880)  WRITE!7,e000) 

0881)  8000  FORHAT!3X»120!’**)) 
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(0882)  URITE(7f 8001) 

(0883)  8001  F0RHAT(A6X, ’REVISION  ACTION  DUE  SEARCH*) 

(088A)  CALL  HEADER 

(0885)  C SET  HEADER  DONE  FLAG 

(08.86)  IPAGE  = 1 

(0887)  C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

(0888)  17  FIRST=1 

(0889)  CALL  MAIND 

(0890)  18  IF(NSHT.GT.l ) GOTO  19 

(0891)  • FIRST=0 

(0892)  GO  TO  15 

(0893)  19  CONTINUE 

(0894)  DO  150  J=2,NSHT 

(0895)  20  READ(12*END=1000)DRU,SHTN,REV»NEOtEOREF 

(0896)  DO  25  K=l»‘t 

(0897)  IF(DRW(K)  .NE.DRAU(K)  ) GOTO  20 

(0898)  25  CONTINUE 

(0899)  IF(NEO.LT.5)  GOTO  150 

UO'P  (0900)  SECOND=l 

(0901)  C INCREMENT  THE  FOUND  COUNTER 

XT"*  (0902)  A5  IF(FIRST.EQ.O)  KNT=KNT+1 

(0903)  KNTTrKNTT+l 

(0909)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(0905)  ILINE=ILINE+NE0+9 

(0906)  C CHECK  FOR  BOTTOM  OF  PAGE 

(0907)  IF(ILINE.LE.A5)  GOTO  32 

(0908)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(0909)  IPAGE=0 

(0910)  C SET  LINE  COUNTER  BACK  TO  0 

(0911)  ILINE=0 

(0912)  C IS  A HEADER  REQUIRED  NOW 

(0913)  32  . IF( IPAGE.NE.O)  GOTO  50 

(0914)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(0915)  ILINE=ILINE+12 

(0916)  C'  PRINT  HEADER  ON  PRINTER  OUTPUT 

(0917)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(0918)  CALL  TIM0AT(ARRAY.15) 

(0919)  AHIN=ARRAY(4 ) 
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(0920) 
(0921) 
(0922) 
(0923) 
( 092A) 
(0925) 
(0926) 
(0927) 
(0928) 
(0929) 
(0930) 
(0931) 
(0932) 
(0933) 
(0939) 
(0935) 
(0936) 
(0937) 
(0938) 
(0939) 
(0990) 
(0991 ) 
(0992) 
(0993) 
(0999) 
(0995) 
(0996) 
(0997) 
(0998) 
(0999) 
(0950) 
(0951) 


aH=AHIN/60.0 

IH=AH 

IMM=IH*60 

IMIN=AHIN 

IDM=IHIN-IHM 

WRITE(7,8D08) IH, IDM,( ARRAY( I) t 1=1*3) 

WRITE(7,8000) 

WRITE(7,8001) 

CALL  HEADER 

C SET  HEADER  DONE  FLAG 

IPAGE=1 

C DISPLAY  AND  PRINT  DRAL'ING  ON  TERMINAL  AND  PRINTER  OUTPUT 

50  CALL  MAIND 
150  CONTINUE 
FIRST=0 
SECONO=0 
INEO=0 
GO  TO  15 

100  URITE(1,200)KNT,KNTT 

200  F0RHAT(1X**THERE  ARE  **I9*»  DRAWINGS  WITH  A TOTAL  OF  »*I9*/ 
1*  SHEET(S)  IN  THE  DRAWING  SUBFILE  WHICH  MUST  BE  REVISED*) 
IF(KNT.EQ.O)  RETURN 

CALL  SRCH$$(K$CLOS* *DRAW  *,6«0*0*0) 

CALL  SRCHIKKSCLOS,  *Eb  », 6*0, 0,0). 

CALL  SRCH$$  (KSCLOS, ’SHEET  **6,0, 0*0) 

CALL  SRCHIS (KSCLOS, 'OUT  *, 6, 0*0,0) 

CALL  COMISK  *£OUT*  ,9,12*10 
CALL  EXIT 

1000  WRITE(1*1001) 

1001  FORMAT!*  AN  ERROR  HAS  OCCURRED  DURING  DATA  ’SE AR CH ! * ) 

RETURN 

END  • 
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ACTDUE 

R 

000000 

0824S 

AH 

R 

0 0 1 1 5 A 

0P73M 

0874 

0920H 

0921 

AMIN 

R 

001156 

0872M 

0873 

0876 

0919H 

ARRAY 

I 

000002 

082PS 

0871A 

0872 

0878 

BREAKS 

R 

external 

000000 

0847 

COMISS 

R 

EXTERNAL 

000000 

0946 

DRAU 

J 

// 

000000 

0825S 

0852M 

0897 

DRW 

J 

// 

000226 

0825S 

0895M 

0897 

DT 

I 

// 

000130 

0825S 

0852M 

EOT 

T 

// 

000A37 

0825S 

EON 

J 

// 

000312 

0S25S 

EOREF 

J 

// 

0002A2 

0825S 

0895H 

EOREV 

I 

// 

C00A36 

0825S 

EOVEH 

I 

// 

000AA5 

0825S 

EPTIT 

J 

// 

000370 

0825S 

EROT 

I 

// 

000A<t2 

0825S 

ETIT 

J 

// 

000316 

0825S 

EXIT 

R 

EXTERNAL 

000000 

0947 

FEOREF 

J 

tt 

000156 

0825S 

0852M 

FIRST 

I 

// 

000465 

0825S 

0835M 

0P88H 

0891M 

FNEO 

I 

// 

000155 

0825S 

0852M 

0853 

0858 

FREV 

I 

// 

000154 

0925S 

0852M 

HEADER 

R 

EXTERNAL 

000000 

0884 

0928 

I 

I 

001160 

087BM 

0925M 

IC 

I 

001162 

0946A 

IDM 

I 

001163 

0S77M 

0878 

0924M 

0925 

IDR 

J 

// 

000452 

0325S 

IH 

I 

001164 

0S74M 

0875 

0878 

0921M 

ILINE 

I 

001165 

0828S 

0843M 

0858H 

0860 

0907 

0911M 

0915M 

IHIN 

I 

001166 

0876M 

0877 

0923H 

0924 

IHH 

I 

001167 

0875M 

0877 

0922M 

0924 

INED 

I. 

// 

000462 

0S25S 

0839M 

0936M 

IPAGE 

I 

001170 

0828S 

0841K 

0862H 

0866 

0930M 

J 

I 

001171 

0894M 

K 

I 

001172 

0896M 

0897 

KSALLO 

1 

PARAMETER 

0326S 
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0920  0923 

0918A  0919  0925 


0902  0934M 


0922  0925 

086.4H  0868M  0905M 


0886M  0909H  0913 
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KJCACC 

I 

Parameter 

0826S 

KSCLOS 

I 

PARAMETER 

0B26S 

KSCONV 

I 

PARAMETER 

0826S 

KJCURR 

I 

PARAMETER 

0826S 

KSDELE 

I 

PARAMETER 

0826S 

KSDMPB 

I 

PARAMETER 

0826S 

KIDTIH 

I 

PARAMETER 

0826S 

KSEtJTR 

I 

000000 

0826S 

KSEXST 

I 

PARAMETER 

C826S 

KIGONO. 

I 

PARAMETER 

C826S 

K$GPOS 

I 

PARAMETER 

C82f.S 

KSHOHE 

I 

PARAMETER 

0826S 

KSICUR 

I 

PARAMETER 

0826S 

KSIHFD 

I 

PARAMETER 

0826S 

KSIRTN 

I 

PARAMETER 

082GS 

KlISEG 

.1 

PARAMETER 

D82f.S 

KSIUFO 

1 

parameter 

0826S 

KSMENT 

I 

000000 

0S26S 

KIMSIZ 

I 

PARAMETER 

0826S 

K$f*VNT 

T 

PARAMETER 

0B26S 

KSNDAM 

I 

PARAMETER 

08  2f.S 

KSNRTN 

T 

PARAMETER 

C828S 

KSNSAH 

I 

PARAMETER 

0826S 

KSNSGD 

1 

PARAMETER 

CB2P.S 

K$N3GS 

I 

PARAMETER 

082f.S 

KSPOSA 

I 

PARAMETER 

082&S 

KSPOSN 

I 

PARAMETER 

0826S 

L 

r « r>  « n C » C A 

U3i;b^ 

KSPREA 

I 

PARAMETER 

0826S 

KSPRER 

I 

PARAMETER 

08285 

KIPROT 

I 

PARAMETER 

C826S 

KSROUR 

I 

PARAMETER 

0828S 

KSRCAO 

I 

PARAMETER 

0828$ 

KSRPOS 

I 

PARAMETER 

0826S 

XSRSU3 

I 

PARAMETER 

C82FS 

KiRWLK 

I 

PARAMETER 

0826S 

KISENT 

I 

000000 

08285 

KSSETC 

I 

parameter 

0B28S 

09A3 


0944 


0945 


) 
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) 
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KSSETH 

I 

PARAMETER 

0826S 

XSSPOS 

I 

PARAMETER 

C826S 

KSSRTN 

I 

PARAMETER 

0826S 

KSTRNC 

I 

PARAMETER 

0826S 

XJUPOS 

I 

PARAMETER 

0826S 

KSU'RIT 

I 

PARAMETER 

0826S 

KNT 

J 

// 

000A&3 

0B25S 

0845M 

0855H 

0902H 

0938  0941 

KNTT 

J 

001173 

0827S 

0H46M 

0856H 

0903H 

0938 

HAI.NO 

I 

EXTERNAL 

000000 

0889 

0932 

NEO 

I 

II 

0002R1 

0825S 

089bM 

0899 

0905 

NSHT 

I 

II 

000153 

C8  25S 

0852M 

0890 

0894 

PTIT 

J 

// 

OOOOC2 

0325S 

0352H 

R 

I 

II 

000451 

08P5S 

REV 

I 

// 

000240 

0825S 

0895M 

SECOND 

I 

// 

000466 

0825S 

0837H 

0900H 

0935H 

SECT 

J 

7/ 

000145 

0B25S 

0852M 

a 

SHTN 

I 

n 

000236 

0S25S 

0895M 

a> 

SRCHSS 

R 

EXTERNAL 

000000 

0942 

0943 

0944 

0945 

in 

SYS 

J 

II 

000133 

0825S 

0852H 

TIHDAT 

R 

EXTERNAL 

000000 

0871 

0918 

TIT 

J 

// 

000010 

C825S 

0852M 

TTIT 

J 

// 

000467 

0825S 

VEH 

I 

// 

000141 

0825S 

0852M 

f ' 

1 . 

000052 

0848 

0849D 

_100 

000730 

0852 

0938D 

_1000 

001114 

0895 

0948D 

• 

1001 

001121 

0948 

0949D 

000152 

0S52D 

0692 

0937 

150 

000714 

0894 

0899 

09330 

17 

000446 

0866 

0888D 

_18 

000452 

0853 

0890D 

19 

000463 

0890 

03930 

• 

_2  0 

000467 

08950 

0897 

_200 

000742 

0938 

09390 

-25 

000536 

0896 

08980 

31 

000257 

0860 

08660 

• 

_32 

' 

000612 

0907 

09130 

■' 

■ 
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_‘»5 

000554 

0902D 

_5  0 

000713 

0913 

0932D 

8000 

000404 

0880 

0881D 

0926 

Is  001 

000420 

0882 

08830 

0927 

_80  0 8 

000355 

0878 

0879D 

0925 
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(0952) 
(0953)  C 
(0953)  C 
(0953)  C 
- (0953) 
(0953) 
(0953) 
(0953) 
(0953)  C 
(0953)  C 
(0953)  C 
(0953) 
(0953) 
(0953) 
(0953) 
(0953) 

O (0953) 

' (0953)  C 

5 (0953)  C 
(0959)  C 
(0959) 
(0955) 
(0956)  C 
(0957)  C 
(0958)  C 
(0959)  C 
(0960) 
(0961)  C 
(0962) 
(0963)  C 
(0969) 
(0965) 
(0966)  1 

(0967)  2 

(0968) 
(0969) 
(0970).  3 

(0971) 


SUBROUTINE  ALDU 

COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

COMMON  DRAW  »TIT ,PTIT  » DT , S YS , VEHt S ECT t NSHT , FREV » FNEO » FEOREF i 
1 DRU»SHTN*REV,NEO«EOREF, 

1 e:on,etit,eptit,eorev»edt,erdt*eoveh* 

1 R» IDR. I NEO » K NT, FIRST, SECOND »TT  IT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

ORAU(9),TIT(21),PTn(19),SYS(3),SECT(3),FEOREF(10,2)» 
DRU(9),EOREF(10,2),EPTIT(19),ETIT(21),EON(2), 
IDR(9).KNT,TTIT(19) 

DT(3),VEH(2,2),NSHT,SHTN(2),FREV,FNE0,REV,NE0» 
EOREV,EOT(3),ERDT(3),EOVEH(2,2),R,INEO, 

FIRST, SECOND 
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I0PT,ARRAY(15) 

PRINT  ALL  ROUTINE 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

INI TIALI 2E  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

CALL  BREAK$(.TRUE.) 

URITE(1,2) 

FORMAT!*  WHICH  PRINT  ALL  OPTION  DO  YOU  UISHI*,/, 

119X, ‘DRAUING  AND  E.O.»*S  ( DE ) • , /, 19 X, • E . 0. • »S  ONLY  (EO)*) 

READ(1,3) lOPT 
FORMAT! 1A2) 

IF( lOPT.EQ. *EO* ) GOTO  259 


INTEGER*9 

1 

1 

INTEGER*2 

1 

1 


SYSCOM>KEYS.F 
NOLI  ST. 
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(0972)  1F{I0PT.NE.»DE» ) GOTO  1 

(0973)  5 URITE(ltlO) 

(097A)  10  FORMAT(*  THIS  IS  THE  PRINT  ALL  ROUTINE  »»/. 

(0975)  1 * ALL  DRAWINGS  STORED  IN  THE  DRAW  FILE  WILL  BE  SPOOLED't/ 

(0976)  2»  AND  A TOTAL  COUNT  OF  THE  DRAWINGS  WILL  BE  GIVEN**//) 

(0977)  20  READ(6,END=100)ORAW,TIT,PTIT,DT,SYS,VEH,SECT,NSHT*FREV*FNEO*FEOREF 

(0978)  C INCREMENT  THE  FOUND  COUNTER 

(0979)  KNT=KNT+1 

(0980)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(0981)  ILINE=ILINE*FNE0+NSHT+3 

(0982)  C CHECK  FOR  BOTTOM  OF  PAGE 

(0983)  IF(ILINE.LE.A5)  GOTO  31 

(OOeA)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(0985)  IPAGE=0 

(0986)  C SET  LINE  COUNTER  BACK  TO  0 

(0987)  ILINE=0 

(0988)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

-I  (0989)  ILINE=r NEO+NShT+3 

(0990)  C IS  A HEADER  REGUIRED  NOW 

(0991)  31  IF(IPAGE.NE.O)  GOTO  150 

^ (0992)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(0993)  ILINE=ILINE+12 

(099A)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

(0995)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(0996)  CALL  TIMD AT ( ARR AY , 15 ) 

(0997)  AMIN=ARRAY(A) 

(0998)  AH=AMIN/60.0 

(0999)  IH=AH 

aOOO)  IMM=IH»60 

(1001)  IMIN=AMIN! 

(1002)  IDM=IMIN-IMM 

(1003)  WRITE(7,8008)IH*IDM,(ARRAY(I),I=1,3) 

(lOOA)  8008  F0RMAT(*1*,100X*I3**:»,I3*AX*2(A2**/*)*A2) 

(1005)  WRITE(7,8000) 

(1006)  8000  FORMAT(3X,120(***) ) 

(1007)  WRITE(7,8001 ) 

(1008)  8001  FORMAT(50X,*  PRINT  ALL  DRAWINGS*) 

(1009)  CALL  HEADER  ^ 


) 
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(1010) 
(1011) 
(1012) 
(1013) 
( 1 0 1 A ) 
(1015) 
(1016) 
(1017) 
(lOlS) 
(1019) 
(1020) 
(1021) 
(1022) 
(1023) 
(102A) 
(1025) 
(1026) 
(1027) 
'p  (102S) 
•S'  Cr>  (1029) 
(1030) 
(1031) 
(1032) 
(1033) 
(103A) 
(1035) 
(1036) 
(1037) 
(1038) 
(1C39) 
(lOAO) 
(1041) 
(1042) 
(1043) 
(1044) 
(1045) 
(10.46) 
(1047) 


C SET  HEADER  DONE  FLAG 

IPAGE=1 

C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

150  CALL  DMAIN 

C INCREMENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

ILINE=ILINE*INEO 

C IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

IF(ILINE.LE.45)  GOTO20 
C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

IPAGE=0 

C RESET  THE  LINE  COUNTER  TO  0 

ILINE=0 

GO  TO  20  . 

100  WRITE(lt200)  KNT 

200  FORMATC*  THERE  ARE  *19*  DRAWINGS'  IN  THE  DRAW  FILE’t/) 

240  CALL  SRCHS$(K$CLOS, ’DRAW  •♦6*0*0t0> 

CALL  SRCH$$(K$CLOS» »EO  *»6f0*0»0) 

CALL  SRCH$$ (KlCLOSf 'SHEET  '»6»0»0»0) 

CALL  SRCHSt (K$CLOS» 'OUT  '»6»0f0t0) 

CALL  C0NI$J('S0UT*,4,12,IC) 

CALL  EXIT 

259  WRITE(1*11) 

11  FORMAT!'  THIS.  IS  THE  PRINT  ALL  ROUTINE  »,/» 

1 ' ALL  ENGINEERING  ORDERS  STORED  IN  THE  EO  FILE  WILL  BE  SPOOLED'*/ 
2'  AND  A TOTAL  COUNT  OF  THE  E.O."S  WILL  BE  GIVEN',//) 

260  REAO(18,END=350)  EON , ET I T , EPT I T , EORE V, EOT, ERDT ,EOVEH 
KNT=KNT+1 

IF( IPAGE.NF.O)  GOTO  302 

C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

CALL  TIMDAT(ARRAY,15) 

AMIN=ARRAY(4) 

AH=AMIN/60.a 
IH  = AH 
IHM=IH*60 
IHIN=AMIN 
IDM=IMIN-IMH 

WRITE ( 7,8008) IH, IDM, ( ARRAYd ) ,1=1,3) 

WRITE(7,300) 
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(10A8)  300  P0RHAT(AXtll5( •*• ) ,/,A5X, »E.O.  SEARCH  - PRINT  ALL»»/t 

<10A9)  19X,»E.O.  NUHBER»*8X»»DATE’»6X* *E.O.  T I TLE » t / * A X, 115 ( • * • ) t /, IHO ) 

(1050)  1PAGE=1 

(1051)  302  CONTINUE 

(1052)  130  F0RMAT(3X,I2,».  E.O.  T I TLE » » / » 3X, 19 A A ) 

(1053)  IF(E0REV.EQ.»NC*)  GOTO  250 

(105A)  WRITE(  7,2  30  ) KNT . EON t EOR E V , ERDT  » EPT I T 

(1055)  230  FORMAT!  *0  • f lA  . » , 2 AA , 1 X i • KE V • » A2 * 3X  ♦ 2 ( 1 2 1 ' - • ) * 1 2 ♦ 

(1056)  13X,19AA) 

(1057)  . URITE(lflAO)  KN T» EON  ♦ EORE V , ER DT, ( ( EO VEH ( I , J ) , J = 1 1 2 ) » I = 1 »2 ) 

( 1058)  lAO  FORMAT (2X, I A, • . • ,2X,2AAi IX. *RE V ♦ . A2 , 5X . 2 ( 1 2. • - • ) , I 2 , 3 X .2 ( 2X  . 
(1059)  1 13, AD) 

(1060)  GO  TO  60 

(1061)  250  URITE(7,230)KNT,EON,EOREV,EDT,EPTIT 

(10.62)  WRITE(l.lAO)  KNT,  EON , EOR  E V , EOT  , ( ( EO  VEH  ( 1 , J ) , J=  1 , 2 ) , I =1 , 2 ) 

(1063)  60  IF(KNT/21.EQ.KNT/21.)  IPAGE=0 

0 <io6A)  call  PAUS 

1 (1065)  GO  TO  260 

(1066)  350  URITE(1,360)KNT 

(1067)  360  FORHATC  THERE  ARE  *I9»  E.O.*»S  IN  THE  EO  SUBFILE*,/) 

(1068)  GO  TO  2A0 

(1069)  END 
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AH 
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J 
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EXIT 

R 

EXTERNAL 

OOOOOO 
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J 
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FIRST 

I 

// 

000465 
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fn'eo 

I 
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I 
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.R 

EXTERNAL 
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I 
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001706 
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ic 
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IDH 
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1045H 

1046 
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J 

n 

000452 

0953S 

IH 

I 

001711 

0999H 

1000 

1003 
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ILINE 

1 

001712 
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0901H 

0983 

0987H 

1017 

1021H 

IMIN 

I 
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1002 
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I 

// 
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lOAl  1044 
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1061  1062 

1057  1061  1062 


1043  1046 

0*989H  0993M  1015H 
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KSALLO  I PAkAHETER 
KSCACC  I PARAMETER 
KtCLOS  I PARAMETER 
KSCONV  I PARAMETER 
KICURR  I PARAMETER 
KtDELE  I PARAMETER 
KtDMPS  I PARAMETER 
KSDTIM  I PARAMETER 
KSENTR  I 000000 

KSEXST  I PARAMETER 
KSGOND  I PARAMETER 
KSGPOS  I PARAMETER 
KSHOME  I PARAMETER 
KSICUR  I PARAMETER 
KSIMFD  I PARAMETER 
KSIRTN  I PARAMETER 
KSISEG  I PARAMETER 

KiiuFO  I Parameter 

KSMENT  I 000000 

KSMSIZ  I PARAMETER 
O KIMVNT  I PARAMETER 
KSNDAH  I PARAMETER 
KSNRTN  I PARAMETER 
KSNSAH  I parameter 
KSNSGD  I PARAMETER 
KSNSGS  I PARAMETER 
KSPOSA  I PARAMETER 
KJPOSN  I PARAMETER 
KIPOSR  I PARAMETER 
KSPREA  I PARAMETER 
KSPRER  I PARAMETER 
, KSPROT  I PARAMETER 
KSRDUR  1 PARAMETER 
KSREAD  I PARAMETER 
KSRPOS  I PARAMETER 
KSRSUB  I PARAMETER 
KSRULK  I PARAMETER 
KSSENT  I 000000 


095AS 

095<iS 

095AS  1025  1026  1027  1028 

095AS 
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095AS 
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095AS 
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095AS 

C95AS 

095AS 
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095AS 

095AS 
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C95AS 

095AS 

09o<lS 

OBbRS 
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KSSETC 

I 
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KSSETH 

I 
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KSTRNC 

I 

PARAMETER 
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I 
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KNT 

J 

// 

000963 
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(1070) 
(1071)  C 
(1071)  C 
(1071)  C 
(1071) 
(1071) 
(1071) 
(1071) 
(1071)  C 
(1071)  C 
(1071)  C 
(1071) 
(1071) 
(1071) 
(1071) 
(1071) 
(1071) 
(1071)  C 
(1071)  C 
(1072) 
(1073)  C 
(107A)  C 
(1075)  C 
(1076)  C 
(1077)  C 
(1078) 
(1079)  C 
(1080) 
(1081)  C 
(1082) 
(1083)  C 
(1084) 
(1085) 
(1086)  1 
(1087)  2 

(1088) 
(1089)  3 

(1090)  999 


SUBROUTINE  VEHND 

COMMON  BLOCK  FOR  THE  ORAW-EO  FILE 

COMMON  DRAW*TIT,?TIT,OT,SYS,VEHtSECT»NSHT»FREV»FNEO»FEOREFt 
1 DRU.SHTN,REViNEO*EOREF, 

1 EON*ETIT,EPTIT,EOREV«EDTtERDT,EOVEH» 

1 R»IDR.INEO,KNT,FIRST,SECOND,TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

DRAW(4)  ,TIT(21  ) tPTIT(19),SYS(3),SECT(3),FEOREF(10t2) , 
DRW(4),ECRCF(10*2) ,EPTIT( 19) »ETIT(21)tE0N(2) * 
IDR(4),KNT,TTIT(19) 

DT(3) tVEH(2t2) ,NSHT,SHTN(2),FREV,FNE0»REV»NE0, 
r.0REV,EDT(3)  ,ERDT(3)  *E0VEH(2»2)  *R»  INEOt 
FIRST, SECOND 


INTEGER*2  lOPT , AR R A Y ( 15 ) 


THIS  ROUTINE  LOCATED  ALL  ENTRIES  IN  THE  DRAWING  FILE 
WHICH  ARE  RELATED  TO  EITHER  A SPECIFIC  VEHICLE  OR  VEHICLE 

INTEGER*2  VEHl ( 2 ) , VS ( 4 ) 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

CALL  CLEAR 
WRITE(1,2) 

FORKATCWHAT  IS  THE  DESIRED  VEHICLE  NUMBER’) 
READ(1,3,ERR=1) VEHl 
FORMAT(2( 13, AT) ) 

WRITE(1,100) 


INTEGER*4 

1 

1 

INTEGER»2 

1 

1 
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(1091)  loo  F0RHAT(*WHAT  is  the  first  valid  vehicle  NUHBER'f/) 

(1092)  READ( 1» 101,ERR=999) ( VS( I ) ,1=1 ,2) 

(1093)  998  WRITE(1,102) 

(1094)  102  FORHAK'WHAT  IS  THE  LAST  VALID  VEHICLE  NUMBER*,/, 

(1095)  I'NOTE  - THE  DEFAULT  IS  VEHICLE  999*) 

(1096)  READ (1,101  ,ERR  = 998) (VS( I ),  1=3,4  ) 

(1097)  101  F0RMAT(I3,A1,2X,I3,A1) 

(1098)  IFEVEHKD.LT.VSd)  ) GO  TO  999 

(1099)  IF(VS(3).EQ.O)  VS(3)=999 

(1100)  . IF(VS(3).LT,VEH1(1 ) ) GO  TO  998 

(1101)  10  URITE(1,11) 

(1102)  11  FORHAT(*  DO  YOU  UISH  A LIST  OF  ALL  E.O.**S  FOR  A SPECIFIC  VEHICLE 

‘1103)  l:  ENTER  EO*,/,»  OR  A LIST  OF  DRAWINGS  RELATED  TO  SPECIFIC  VEHICLE 

(1104)  1 : enter  dr*) 

(1105)  READ(1,12)I0PT 

(1106)  12  FORHAT( A2) 

(1107)  IF( lOPT .EQ. *EO* ) GOTO  300 

(1108)  IF( lOPT.NE. *DR* ) GOTO  10 

(1109)  4 READ(6, END=202) DRAW, TIT, PTIT,DT,SYS,VEH, SECT, NSHT,FREV,FNEO,FEOREF 

(1110)  1F(VEH(1,1).LT.VS(D)  GO  TO  4 

(1111)  IF(VEH(2,1).GT.VS(3))  GO  TO  4 

‘1112)  IF(VEH(1,2).NE.*S*.AND.VEH(1,1).EQ.VEH1(1))  GO  TO  1001 

‘111^1  IF ( VEH( 1,2 ) .EQ. *S * . AND. VEH(1 ,1 ) . LE. VEHl (1) ) GO  TO  1001 

(1114)  GO  TO  4 

(1115)  1001  CONTINUE 

(1116)  C INCREMENT  THE  FOUND  COUNTER 

(1117)  KNT=KNT+1 

(1118)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1119)  ILINE=ILINE+FNE0+NSHT+3 

(1120)  C CHECK  FOR  BOTTOM  OF  PAGE 

(1121)  IF(ILINE.LE.45)  GOTO  31 

(1122)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(112,3)  IPAGE=0 

(1124)  C SET  LINE  COUNTER  BACK  TO  0 

(1125)  ILINE=0 

(1126)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1127)  ILINE=FNEO+NSHT+3 

(1128)  C IS  A HEADER  REQUIRED  NOW 
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C1129)  31  IF(IPAGE.NE.O)  GOTO  150 

(1130)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(1131)  ILINE=ILINE*12 

(1132)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

(1133.)  C FETCH  AND  L’RITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(113A)  CALL  TIMDAT(ARRAY,15) 

(1135)  AHIN  = ARRA  Yt')) 

(1136)  AH=AHIN/60.0 

(1137)  . IH=AH 

(113fi)  . IHH=IH*60 

(1139)  IMIN=AHIN 

(llAO)  IOH=IMIN-IMH 

(HAD  URlTE(7«8008)IH»IDH,(ARRAY(I)fI  = l»3) 

(11A2)  8008  FORHAT(»1*.100X,I3.»:».I3*AX,2(A2«»/*)»A2) 

(11A3)  U'RITE(7»8000  ) 

(llAA)  8000  FORMAT(3X,120(»*»)) 

(11A5)  URITE(7,8C01) VEHl 

O (11A6)  8001  F0RHAT(A5X, ‘VEHICLE  SEARCH  : •,I3.A1> 

^ (1147)  CALL  HEADER 

(1148)  C SET  HEADER  DONE  FLAG 

(1149)  IPAGErl 

(1150)  C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

(1151)  150  CALL  DHAIN 

(1152)  C INCREMENT  LINE  COUNTER  FOR  DRAWING  RECDRD  PRINTED  FOR  OUTPUT 

(1153)  ILINE=IL INE+INEO 

(1154)  C IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

(1155)  IF(ILINE.LE.45)  GOTO  4 

(1156)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(1157)  IPAGE=0 

(1158)  C RESET  THE  LINE  COUNTER  TO  0 ' 

(1159)  ILINE=0 

(1160)  GO  TO  4 

(1161)  202  WRITE(l»201)KNTfVEHl 

(1162)  201  FORMAT( ‘THERE  ARE  ‘I10»  DRAWINGS  RELATING**/* 

(1163)  1*T0  VEHICLE  »I3*A1/) 

(1164)  RETURN 

(1165)  300  REAO(18*END=400)  EON *ET I T * EPT I T * EORE V *EDT*ERDT *EO VEH 

(1166)  IF(EOVEH(ltl).LT.VS(D)  GO  TO  3Q0 
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(1167) 

IF(E0VEH(2tl).GT.VS(3) ) GO  TO  300 

(1168) 

IF(E0VEH(lf2).NE.’S*.AND.E0VEH(lfl).EQ.VEHl(l))  GO  TO  1002 

(1169) 

IF(E0VEH(1 ,2) . EQ. •$» . AND.EOVEHd ,1 ) .LE. VEHl (1 ) > GO  TO  1002 

(1170) 

GO  TO  300 

(1171) 

1002 

CONTINUE 

(1172) 

KNT=KNT+1 

(1173) 

IF(IPAGE.NE.O)  GOTO  302 

(H7A) 

C 

FETCH  AND  WRITE  TIKE  AND  DATE  TO  OUTPUT  FILE 

(1175) 

CALL  TIMDAT (ARRAY, 15) 

(1176) 

AMIN=ARRAY(9) 

(1177) 

AH=AHIN/60.0 

(1178) 

IH  = AH 

(1179) 

IHM=IH*6D 

(1180) 

IKIN=AHIN 

(1181  > 

IDM=IKIN-IHM 

(1182) 

URITE(7,8008)IH,IDH,(ARRAY(I),I=1,3) 

o 

(1183) 

UR  ITE(7,399) VEHl 

(118A) 

399 

F0RKAT(9X,115( ***) ,/,50X, 'E.O.  VEHICLE  SEARCH  • , 2 ( 13 » A1 ,2 X ) ) 

(1185) 

URITE(7,351) 

4T 

(1186) 

351 

FORMAT! 19X, *E.O.  NUMBER ♦, 9X ,* DATE *, 6X ,♦ E .0 . TITLE*,/,9X,115(»**)) 

(1187) 

IPAGE=1 

(1188) 

302 

IF(EOREV.EO.*NC»)  GOTO  350 

(1189) 

UR ITE (1,310 )KNT,EON,EOREV,ERDT 

(1190) 

310 

F0RKAT(3X,I9,».  *, 

0 

(1191) 

l*E.O.  number:  * ,2A9 ,5X,  *E.0.  rev  ♦,A2,5X,*0ATE  ♦, 

(1192) 

12(12,  •-’) ,12) 

(1193) 

URITE(7,320)KNT,EON,EOREV,ERDT,EPTIT 

(119A  ) 

320 

FORHAT(»0*,2X,I7,».  • , 2 A9 , 2 X , • REV  • , A2 , 3X , 2 ( 12 , » - • ) , I 2, 

(1195) 

13X,19A9) 

(1196) 

GO  TO  325 

(1197) 

350 

URITE(1,310)KNT,EON,EOREV,EOT 

(1198) 

WRITE! 7,320 )KNT, EON, E ORE V,EDT,EPT IT 

(1199) 

325 

CONTINUE 

(1200) 

IF(EPTIT(1).NE.»  •>  WRITE(1,311)EPTIT 

(1201) 

311 

F0RHAT(3X,19A9) 

(1202) 

IF(KNT/21.EO.KNT/21.)  IPAGE=0 

(1203) 

CALL  PAUS 

(120A) 

GO  TO  300 
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(1005)  400 

(1206)  402 

(1207) 
(1208) 


URITE(1«402)KNT«VEH1 

FORHAK*  THERE  ARE  »*I7t»  E.O.»»S  RELATED  TO  VEHICLE  *»I3»A1/) 
RETURN 
END 
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. * i . ' » 


SUBROUTINE  VEHND 


PTIT 
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(1209)  SUBROUTINE  SECTN 

(1210)  C 

(1210)  C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

(1210)  C 

(1210)  COMMON  ORAU'tTIT,PTIT,OT,SYS,VEH,SECT,NSHT»FREV»FNEOtFEOREF« 

(1210)  . 1 ORU,r.HTN,REV,NEO,EOREFf 

(1210)  1 EON,ETITtF?TIT.EOREV,EDT,ERDT»EOVEH» 

(12iJ)  1 Rf IDRtINEOiKNT,FIRSTtSECOND»TTIT 

(1210)  C 

(1210)  C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE  • 

(1210)  C 

DRAW(A)  ,TIT(21)  tPTIT.(19),SYS(3)»SECT(3)tFE0REF(10»2)» 
ORU(A),EOREF(10,2),EPTIT(19).ETIT(21)tEON(2). 

IDR( A),KNT,TTIT( 19) 

DT(3) ^VEH (2,2) ,NSHT ,SHTN(2),FREV»FNE0tREV,NE0» 
E0REV,EDT(3) ,ERDT(3),E0VEH(2,2) ,R,INEO, 

, FIRST, SECOND 


LO  (1211)  C 

(1212)  C 

(1211j  C this  routine  LOCATES  A DRAWING  WITH  A SPECIFIED 

(1214)  C SECTION 

(1215)  C 

(1216)  INTEGER*4  ISECT(3) 

(12in  INTEGER»2  ARRAYdS) 

(1218)  C INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 

(1219)  IPAGE=0 

(1220?  C INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 

(1221)  ILINE=0  . ' 

(1222)  C INITIALIZE  THE  FOUND  COUNTER 

(1223)  KNT=0 

(1224)  3 URITE(1,1) 

(1225)  1 FORMATC  WHAT  IS  THE  DESIRED  SECTION*/) 

(1226)  READ(1,2,ERR=3)ISECT 

(1227)  2 F0RMAT(3A4) 

(1228)  WRITE(l,2)'lSECT  • 

(1229)  100  READ(6,END=200)ORAU,TIT,PTIT,DT,SYS,VEH,SECT,NSHT,FREV,FNEO,FEOREF 


(1210) 
(1210) 
(1210) 
(1210) 
(1210) 
(1210) 
O (1210) 
(1210? 


INTEGER*4 


INTEGER*2 
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(1230J  DO  1000  I=lt3 

(1231)  IFdSECK  I)  .NE.SECT  ( I ) ) GO  TO  100 

(1212)  1000  CONTINUE 

(1231)  C INCREMENT  THE  FOUND  COUNTER 

(123A)  KNT=KNT*1 

(1235).  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1216)  • ILINE=ILINE+FNE0+NSHT*3 

(123?)  C CHECK  FOR  BOTTOM  OF  PAGE 

. (1238)  IF(ILINE.LE.A5)  GOTO  31 

(1219)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(12A0:  IPAGE=0 

(12<il?  C SET  LINE  COUNTER  BACK  TO  0 

(12A2>  ILINE=0 

(12A3)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(12AA)  ILINE=FNE0+NSHT+3 

(12A5)  C IS  A HEADER  REQUIRED  NOW 

(12.A6)  31  IF(IPAGE.NE.O)  GOTO  150 

(12A7)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

(12A8)  ILINE  = ILINE  + 12 

(12A9)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

(1250)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

' (1251)  CALL  TIHDAT(ARRAY,15) 

(1252)  AMIN=ARRAY(A ) 

(1253)  AH=AMIN/60.0 

(125A)  IH=AH 

(1255)  IMH=IH*60 

(1256)  IMIN=AHIN 

(1257)  IDM=IKIN-IMM  . 

(1258)  WRITE(7,8008)IH,IDM,(ARRAY(I), 1=1*3) 

(1259)  8008  FORMAT(*l**100X,I3,»:»,I3*AX,2(A2,*/») »A2) 

(1260)  URITE(7*8000) 

(1261)  8000  FORHAT(3X,120(»**)) 

(1262)  URITE(7«8001)ISECT 

(1263)  8001  F0RHAT(A5X*»  SECTION  SEARCH  : »,3AA) 

(126A)  CALL  HEADER 

(1265)  C.  SET  HEADER  DONE  FLAG 

(1266)  IPAGE=1 

(1267)  C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 


0-85 
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(12E3)  150  CALL  DMAIN 

(12S9)  C U'CREKENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

(1270)'  ILINE  = ILINE*INEO 

(1271).  C IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

(1272)  IF(  ILINE.LE.'iS)  GOTO  100 

(1273)  C SET  TO  TOP  OF  P.RINTER  PAGE  FLAG 

(1274)  . 1PAGE=0 

(1275)  C ■ RESET  THE  LINE  COUNTER  TO  0 

(1276)  ILINE=0 

(1277)  • GO  TO  100 

(1278)  200  URITE(1»250)KNT»ISECT 

(1279)  250  FORMAT!*  THERE  ARE  *iI9t*  DRAWINGS  RELATED  TO  SECTION*, /t 

(1280)  11X,3A4) 

(1281)  RETURN 

(1282)  END 
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AH  R 00052b 

AMIN  R 000530 

ARRAY  I 000002 

OMAIN  R EXTERNAL  000000 

ORAU  J //  000000 

ORU-  J //  000226 

DT  I 7/  00013C 

EOT  I //  OOOA37 

EON  J //  000312 

EOREF  J //  0002A2 

EOREV  I //  000436 

EOVEH  I //  000445 

EPTIT  J U 000370 

EROT  I It  000442. 

ETIT  J //  000316 

FEOREF  J //  000156 

FIRST  I //  000465 

^ ^ FNEO  I n 000155 

^03  ■ FREV  in  000154 
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OOOOAl 
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(1283) 
(1284)  C 
(1284)  C 
(1284)  C 
(1284) 
(1284) 
(1284) 
(1284) 
(1284)  C 
( 1284)  C 
(1284  ) C 
(1284) 
(1284  ) 
(1284) 

( 1284) 
(1284) 

( 1284) 
(1284)  C 
(1284)  C 
(1285)  C 
(1285) 
(1286)  C 
(1237)  C 
(1283)  C 
(1289)  C 
(1290)  C 
(1291) 
(1292)  C 
(1293) 
(1294)  C 
(1295) 
(1296)  C 
(12«7) 
(1298) 
(1299)  3 

(1300)  1 

(1301  ) 
(1302)  2 


SUBROUTINE  CODE 

COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

COMMON  DR AU,TIT*PTIT  *DTfS YStVEHfSECT»NSHT,FREVtFNEO»FEOREF  * 

1 DRW,SHTN,REV,NEO.EOREF, 

1 EON,ETIT,EPTIT,EOREV,EOT,ERDT,EOVEH, 

1 R»IDRtINEO*KNT,FlRST»SrCOND*TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DHAW-EO  FILE 

DRAW(4),TIT(2l  ) ,PTIT<  19)  ,SYS(3)«SECT  (3)  fFEOREFdOf  2)  ♦ 
DRU(4),EOREF(10,2),EPTIT(19)»ETIT(21),EON(2), 
IDR(4),KNT,TTIT(19) 

DT(3),VEH(2«2>  * NSHT , SHTN ( 2 ) , FRE V , FNE Ot  RE V i NEO t 
E0REV,EDT(3)*ERDT(3),E0VEH(2*2).RtINE0t 
FIRST, SECOND 


MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 


THIS  ROUTINE  LOCATES  A DRAWING  WITH  A SPECIFIED 
VENDOR  CODE 

INTEGER *2  I CODE ( 2 ) , COD ( 2 ) , ARR A Y ( 15 ) 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

CALL  SRCH$$(KtRDUR  + KJNDAH,»T3  », 6, 6,1,10 
WRITE(1,1) 

FORMAT!*  WHAT  IS  THE  DESIRED  VENDOR  CODE*/) 

READ(1,2,ERR=3) ICOOE 

F0RHAT(1A2,1A1) 


INTEGER»4 


INTEGER*2 


SYSCOM>KEYS.F 

NOLIST 
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0 

1 

00 
VO 


0303) 

0304) 

0305) 

0306) 

0307) 

0308) 
O30'3) 
0310) 
0511) 

0312) 

0313) 
0 314) 

0315) 

0316) 

0317) 

0318) 

0319) 

0320) 

0321) 
032  2) 
0 323) 

0324) 

0325) 
032S) 
0527) 
0328) 
0 329) 

0330 

0331  ) 

0332) 

0333) 
0534) 
0335) 
0 336) 
0 33?) 
0358) 
0339) 
0340 


100 


5 


20 

30 
C 

40 

C 

C 

C 

C 

C 

c 

31 
C 

c 

c 


WRITEO»2)ICODE 

READ(6tEND=200)DRAU»TIT»PTIT»DT*SYS,VEH,SECT,NSHT»FREV»FNEO»FEOREF 
REWIND  10 

WRITEOO»5)DRAUO) 

FORHATOA4) 

REWIND  10 
REAOOO«2)COO 

1FOCODEO).EQ.»23»)  GOTO  30 
DO  20  1=1,2 

IF  ( ICODEO  ) .NE.CODO  ) ) GOTO  100 

CONTINUE 

GO  TO  40 

IFOCOOEO). NE.CODO))  GOTO  100 
INCREMENT  THE  FOUND  COUNTER 
KNT=KNT*1 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

ILINE=ILINE+FNE0+NSHT+3 

CHECK  FOR  BOTTOM  OF  PAGE 

IFOLINE.LE.45)  GOTO  31 

SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

■ IPAGE  = 0 

SET  LINE  COUNTER  BACK  TO  0 
ILINErO 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 
ILINE=FNE0+NSHT+3 
IS  A HEADER  REQUIRED  NOW 
IFOPAGE.NE.O)  GOTO  150 
INCREMENT  LINE  COUNTER  FOR  HEADER 
ILINE=ILINE+12 

PRINT  HEADER  ON  PRINTER  OUTPUT 
FETCH  ANO  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 
CALL  TIMDAT(ARRAY,15) 

AMIN=ARRA Y(4 ) . ‘ 

AH=AMIN/60.0 
IH  = AH 
IMH=IH*60 
IHIN=AMIN 
IDH=IMIN-IHM 


subroutine:  code 


<1341)  WRITE(7t8008)IH,IDH, (ARRAY(I) ,1=1,3) 

(1342)  8008  F0RHAT(»1»,100X,I3,»:»,I3,4X,2(A2,»/*)  ,A2) 

(1343)  URITE(7,8000) 

(1344)  8000  FORMAT(3X,120(***)) 

(1345)  URITE(7,8001  ) ICODE 

(1346)  8001  F0RHAT(45X,»  VENDOR  CODE  SEARCH  : •,1A2,A1) 

(1347)  CALL  HEADER 

(1348)  C SET  HEADER  DONE  fLaG 

(1349)  IPAGE=1 

‘1*^0)  C DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

(13M)  150  CALL  DHAIN 

(1352)  C INCREMENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

(1353)  ILINE=ILINf *INFO 

(1334)  C IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

(1355)  IF(ILINE.LE.45)  GOTO  100 

(1356)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(13575  IPAGE=0 

(1353)  C RESET  THE  LINE  COUNTER  TO  0 

(1359)  ILINE=0 

. O (1360)  GO  TO  100 

(1361)  200  WRITE(1,250)KNT, ICODE 

(1362)  250  FORMAK*  THERE  ARE  »,I9,'  DRAWINGS  WITH  THE  SPECIFIED  •»/, 

(1363)  It  VENDOR  CODE  t,lA?,lAl) 

11364)  CALL  SRCHt$(K$CLOS, »T3  *,6,0, 0,0) 

(1365)  CALL  SRCHtt (KJDELE , » 13  », 6, 0,0,0) 

(1366)  RETURN 

(1367)  END 
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SUBROUTINE  CODE 


AH 

R 

000623 

1336M 

1337 

AHIN 

R 

000625 

1335M 

1336 

1339 

ARRAY 

I 

OOOOO? 

1291S 

1334A 

1335 

1341 

COD 

I 

000021 

1291S 

1309H 

1312 

1315 

CODE 

R 

OOOOOO 

12f'3S 

DMAIN 

R 

EXTERNAL 

ooooon 

1351 

DRAW 

J 

// 

OOOOOO 

12M4  S 

1 304H 

1306 

DRW 

J 

// 

000221. 

1284S 

DT 

I 

// 

000130 

1P04S 

1304M 

EOT  • 

' I 

// 

ODOAl? 

12H4S 

EON 

J 

// 

000312 

1284$ 

EOREF 

J 

// 

0002'!? 

1284S 

EOREV 

I 

// 

000 A36 

' 12  84S 

EOVEH 

I 

// 

OOCAAS 

12R4S 

EPTIT 

J 

// 

000370 

1 2 3 4 S 

ERDT 

I 

// 

OOOAA? 

1284$ 

ETIT 

J 

// 

000316 

1234S 

FFOREF 

J 

// 

000156 

12  84$ 

1304H 

FIRST 

1 

// 

000 A65 

1284$ 

FNEO 

I 

// 

000155 

1284S 

1304M. 

1319 

1327 

FREV 

I 

// 

00015A 

12G4S 

1304H 

HEADER 

R 

EXTERNAL 

000000 

1347 

I 

I 

000627 

1311M 

1312 

1341H 

IC 

I 

000630 

' 1250A 

ICODE 

I 

000023 

1291S 

1301M 

■1303 

1310 

1361 

ICM 

I 

000631 

1340M 

1341 

I OR 

J 

// 

OOOA5? 

1284$ 

IH 

I 

000632 

1337H 

1338 

1341 

ILINE 

I 

000633 

1295M 

1319H 

1321 

1325H 

1355 

1359H 

IMIN 

I 

000634  . 

1339M 

1 3 4 0. 

IHM 

1 

000635 

1330H 

1340 

INFO 

I 

// 

000462 

12R4S 

1353 

IFAGE 

I 

000636 

1293H 

1323M 

1329 

1349M 

KIALLD 

I 

PARAMETER 

1205$ 

KJCACC 

I 

PARAMETER 

1285$ 

KJCLCS 

I 

PARAMETER 

1285$ 

1364 

1312  1315  13'15 


1327H  1331M  1353M 


1357H 
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KSCONV 

I 

parameter 

1285S 

KICURR 

I 

PARAMETER 

1285S 

KSDELE 

1 

PARAMETER 

12R5S 

k-:d?ipd 

I 

PARAMETER 

1285S 

KSDTIH 

I 

PARAMETER 

1285S 

KJENTR 

I 

000000 

12R5S 

KSf  XST 

I 

PARAMETER 

T2H5S 

KSGCNO 

I 

PARAMETER 

1285S 

KtOPOS 

I 

PARAMETER 

12P5S 

KiHOME 

I 

PARAMETER 

12S5S 

KSICUR 

I 

PARAMETER 

12R5S 

KJIMFD 

I 

PARAMETER 

12U5S 

KlIRTN 

I 

PARAMETER 

12C5S 

UIISEG 

I 

PARAMETER 

1285S 

KIIUFO 

I 

PARAMETER 

1285S 

KIMENT 

I 

000000 

1285S 

KIMSIZ 

I 

PARAMETER 

1285S 

KiKVNT 

I 

PARAMETER 

1285S 

KtNOAH 

I 

PARAMETER 

1285S 

KINRTN 

I 

PARAMETER 

12P5S 

KSNSAH 

I 

PARAMETER 

1285S 

KJNSGD 

I 

PARAMETER 

1285S 

KINSGS 

I 

parameter 

12R5S 

KSPOSA 

I 

PARAMETER 

, 12P5S 

K$POSN 

I 

PARAMETER 

1285S 

KIPOSR 

I 

PARAMETER 

1285S 

KiPREA 

I 

■PARAMETER 

1 2 8 5 S 

KSPRER 

I 

PARAMETER 

1285S 

■K  JPROT 

I 

PARAMETER 

1285S 

KtRrJUR 

I 

PARAMETER 

1285S 

K SR  CAD 

I 

PARAMETER 

1285S 

KSRf’OS 

I 

PARAMETER 

12f',5S 

Kr.RSUD 

I 

PARAMETER 

12  85:: 

KSRULK 

I 

PARAMETER 

12B5S 

KISENT 

I 

000000 

12H5S 

KISETC 

I 

PARAMETER  . 

1285S 

KtRETH 

I 

PARAMETER 

1235S 

KS5P0S 

I 

PARAMETER  . 

1235S 

1365 


1298 


1298 


D-93 
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KSSRTN 

1 

parameter 

1285S 

KSTRNC 

I 

PARAMETER 

1285S 

K*UPOS 

I 

PARAMETER 

1285$ 

KlWRIT 

I 

PARAMETER 

1235S 

KNT 

j 

// 

000 A63 

12R4S 

1297H 

1317M 

1361 

NEO 

I 

// 

000241 

12R4S 

NSHT 

I 

// 

000153 

12R4S 

1304M 

1319 

1327 

PTIT 

j 

// 

000062 

1234S 

13Q4M 

R 

I 

// 

000451 

1284  S 

REV 

I 

// 

000240 

12R4S 

SECOND 

I 

// 

000466 

1284S 

SECT 

J 

// 

000145 

1234S 

1304H 

SHTN 

I 

// 

000236 

12  84S 

SRCHSJ 

R 

EXTERNAL 

000000 

1298 

1364 

1365 

SYS 

J 

// 

000133 

1284S 

1304M 

TIMDAT 

R 

EXTERNAL 

000000 

1334 

TIT 

J 

// 

000010 

1284S 

1 3 0 4 H 

TTIT 

J 

// 

000467 

12  8 4S 

VEH 

I 

// 

000141 

12M4S 

1 304M 

1 

000054 

1299 

1300D 

100 

000126 

1304D 

1312 

1315 

1355 

II  50 

000501 

1329 

1351D 

000111 

1301 

1302D 

1303 

1309 

20 

000241 

1311 

131  3D 

_2  0 0 

000516  . 

1304 

13610 

250 

000531 

1361 

13620 

~3 

000047 

1299D 

1301 

~3  0 

000250 

1310 

1315D 

'31 

000306 

1321 

1329D 

_A0 

000254 

1314 

13170 

~5 

000207 

1306 

1307D 

lanco 

000431 

1343 

1 3 4 4 D 

la  001 

000450 

1345 

1346D 

_aoo8 

000402 

1341 

1342D 

1360 


0000  ERRORS  C<CODE  >FTN-REV1A .2  ] 
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(1368) 
(1369)  C 
(1369)  C 
(1369)  C 
(1369) 
(1369) 
(1369) 

( 1369) 
(1369)  C 
(1369)  C 
(1369)  C 
(1369) 
(1369) 
(1369) 
(1369) 
(1369) 
(1369) 
(1369)  C 
(1369)  C 
i (1370)  C 
(1371)  C 
(1372)  C 
(1373)  C 
(1374) 
(1376)  C 
(1376) 
(1377)  C 
(1378) 
(1379)  ,C 
(1330) 
(1381)  20 

(1382)  21 

(1383: 
(1384)  22 

(1335)  100 

(13R6> 
(1387) 
(1383)  110 


SUBROUTINE  DATDW 

COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

COMMON  DRAU,TIT»PTIT  * DT , S YS t VEH * S ECT » NSHT* FRE V tFNEO » FEOREF t 
1 DRU,SHTN,REV,NEO,EOREF, 

1 EON,ETIT,EPTIT,EOREV,EDT,ERDT,EOVEH,' 

1 R* IDR » INEO ,KNT,FI RSTtSECONOtTTI T 

DATA  DECLARATION  BLOCK  FOR  THE  ORAU-EO  FILE 

INTEGER *4  DR AW ( 4 ) , T I T ( 2 1 ) » PT I T ( 1 9 ) , S YS ( 3 ) , SECT ( 3 ) t FEOR E F ( 1 0 f 2 ) » 
1 nRW(4),£ORrF(10,2),EPTIT(19),F.TIT(21)tEON(2)» 

1 IDR (4 ) .KNT ,TTI M 1°) 

INTEGER*2  I)  T ( 3 ) ♦ V;  H ( ? , ? ) , NSHT  t SHT  N ( 2 ) » FRE  V » FNEO»  R E V , NE  0 , 

1 r.ORr  v,n)T(3)  . I R0T(3)  »E0VEH(2»2)  »R»INEOi 

1 FIRST, SECOND 


THIS  ROUTINE  LOCATED  ALL  DRAWINGS  WITH  A SPECIFIED  DATE 

INTEGER*2  D ( 3 ) , ARR A Y ( 1 5 ) 

INITIALIZE  THE  TCP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

initialize  THE  FOUND  COUNTER 
KNT  = 0 

URITE(1,21)  ■ , 

FORMAT(»  WHAT  IS  THE  DATE  THAT  YOU  W ANT • , / , ♦ IMMDD Y Y ! » / ) 

READd  ,22,ERR  = 20)D 
F0RMAT(1X,3I2) 

READ(6»END=200)DRAW,TIT,PTIT,DT,SYS,VEH,SECT,NSHT,FREV»FNEO»FEOREF 
IF(D(1 ) .EQ.n  ) GO  TO  110 

IF(D(1)  .NE.DT(D)  CO  TO  100 
IF(D(2) .EQ.O)  GO  TO  120 
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<1389)  1F(D(2).NE.DT<2))  GO  TO  100 

(1390)  120  IF(0(3).EQ.O)  GO  TO  130 

(1391)  1F(D(3).NE.DT(3))  GO  TO  100 

(1392)  130  CONTINUE 

(1393)  C INCREMENT  THE  FOUND  COUNTER 

(1399)  KNT=KNT*1 

(1395)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1396)  ILINE=ILINE ♦FNEO+NSHT+3 

(1397)  C CHECK  FOR  BOTTOM  OF  PAGE 

(1398)  IFCILINE.LE .95)  GOTO  31 

(1399)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(1900)  IPAGE=0 

(1901)  C SET  LINE  COUNTER  BACK  TO  0 

(1902)  ILINE=0 

(1903)  C INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1909)  ILINE=FNE0+NSHT*3 

(1905)  C IS  A HEADER  REQUIRED  NOW 

(1906)  31  IFtIPAGE.NE.O)  GOTO  150 

JO  (1907)  C INCREMENT  LINE  COUNTER  FOR  HEADER 

^ (1908)  ILINE=ILINE+12 

(1909)  C PRINT  HEADER  ON  PRINTER  OUTPUT 

(1910)  C FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

(1911)  CALL  TIHDAT(ARRAY,15) 

(1912>  . AMIN=ARRAY(9)  ' 

(1913)  AH=AMIN/60.0 

(1919)  IH=AH 

(1915)  IMM=IH*60 

(1916)  IMIN=AMIN 

(1917)  IDM=IMIN-IMM 

(191G;  URITE(7.8008)IH»IDH.<ARRAY(I)»I=1,3) 

(1919)  8008  FORMAT(*l*«100X»I3«*:*tI3»9Xi2(A2»*/»)tA2) 

(1920;  URITE(7*8000) 

( 1921)  8000  FORMAT(3X»120( ***)  ) 

(1922)  URITE(7t8001)D' 

(1923)  8001  F0RMAT<95X»*  DRAWING  DATE  SEARCH  : *t2(I2t* 

(1929)  CALL  HEADER 

(1925)  . C SET  HEADER  DONE  FLAG 

(1926)  IPAGE=1 
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<1R27J  C display  and  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

<1*126)  150  CALL  DMAIN 

(1A29J  C INCREMENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

(1030)  ILINE=ILINE+INEO 

(1A31)  C IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

(1A52)  IF(ILINE*Lr .A5>  GOTO  100 

(1033)  C SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(IA3A)  IPAGE=0 

(IA35)  C RESET  THE  LINE  COUNTER  TO  0 

(1A3&)  ILINE=0 

(1A37)  GO  TO  100 

(1A33)  200  WRITE(lf250)KNT,D 

(1A39)  250  FORMAT!*  THERE  ARE  *19*  DRAWINGS  WITH  A DATE  OF  * 2 ( 12  * - * ) » 12 ) 

(lAAO)  RETURN 

<1A41>  END 


0 

1 


SUBROUTINE  DATOU 


AH 

R 

000530 

1413M 

1414 

AMIN 

R 

000532 

1412H 

1413 

1416 

ARRAY 

I 

000002 

1374S 

1411A 

1412 

1418 

0 

I 

000021 

1374S 

1303H 

1306 

1387 

1391 

1422 

1438 

OATOU 

R 

000  000 

1368S 

DMAIN 

R 

EXTERNAL 

000000 

1420 

ORAU 

J 

// 

0 00  00  0 

1369S 

13a5H 

ORU 

J 

// 

00022G 

1369S 

OT 

• I 

// 

000130 

1369S 

13U5M 

1387 

1389 

EDT 

I 

// 

000437 

1369S 

EON 

J 

// 

000312 

1369S 

EORl.F 

J 

// 

000242 

1369S 

ECREV 

I 

// 

000436 

1369S 

EOVEH 

I 

// 

000445 

1369S 

EPTIT 

J 

// 

000370 

1369S 

ERDT 

I 

// 

000442 

1369S 

0 

1 

ETIT 

J 

// 

000316 

1369S 

FEOSEF 

J 

// 

000156 

1369S 

1385H 

FIRST 

I 

// 

000465 

1369S 

FNEO 

I 

// 

000155 

1369S 

1385H 

1396 

1404 

FREV 

I 

// 

000154 

1369S 

1385H 

HEADER 

R 

EXTERNAL 

000000 

1424 

I 

I 

000534 

■ 1418M 

IDM 

I 

000535 

1417M 

1418 

■ 

lOR 

J 

// 

000452 

1369S 

IH 

I 

000536 

1414M 

1415 

1418 

ILINE 

I 

000537 

137PM 

1396H 

1398 

1402H 

1432 

1436H 

IHIN 

I 

000540 

1416H 

1417 

IMH 

I 

000541 

1415H 

1417 

INEO 

I 

ft 

000462 

1369S 

1430 

IPAGE 

I 

000542 

1376H 

1400M 

1406 

1426M 

KNT 

J 

II 

000463 

1369S 

13R0K 

1394H 

1438 

NEO 

I 

n 

000241 

1369S 

NSHT 

1 

n 

000153 

1369S 

13R5M 

1396 

1404 

PTIT 

J 

n 

000062 

1369S 

1385M 

R 

I 

n 

000451 

1369S 
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1388  1389  1390 


1391 


1A04H  1408M  1430H 


1434H 


D-98 
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REV 

1 

// 

0002AO 

1369S 

SECOND 

I 

// 

000466 

1369S 

SECT 

J 

// 

000145 

1369S 

1385H 

SHTN 

I 

// 

000236 

1369S 

SYS 

J 

7/ 

000133 

1369S 

1385H 

TIMDAT 

R 

EXTERNAL 

000000 

1411 

TIT 

J 

// 

000010 

1369S 

1385H 

TTIT 

J 

// 

000467 

1369S 

VEH 

I 

// 

000141 

1369S 

1385H 

_IOO 

000113 

13R5D 

1387  1389 

1391 

1432 

1437 

IllO 

000 171 

1386 

13880 

120 

000200 

1388 

13900 

130 

000207 

139  0 

1392D 

150 

000440 

1406 

1428D 

_20 

000036 

13810 

1383 

_200 

000455 

1385 

14380 

000043 

1331 

13820 

22 

000106 

1383 

13840 

250 

000470 

1438  ' 

14390 

1^1 

000241 

1398 

14060 

8000 

000365 

1420 

14210 

_8  001 

000404 

1422 

14230 

_8  0O8 

000336 

1413 

14190  . 
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(1442 J 
(1443) 

r 

(1443) 

c 

(1443) 

c 

(1443) 

(1443) 

(1443) 

(1443) 

(1443) 

c 

(1443) 

c 

(1443) 

c 

o 

(1443) 

(1443) 

(1043) 

(1443) 

(1443) 

1 

CO 

(1443) 

(1443) 

c 

(1443) 

c 

(1  444  ) 

c 

(1445) 

c 

(1446) 

c 

(1447) 

c 

( 1448) 
(1449) 

( 1450  ) 

c 

( 1451 ) 
( 1452  ) 

c 

(1453) 
( 1454  ) 

c 

(1455) 
( 1456) 

3 

(1457) 

1 

( 1450) 
(1459) 

2 

( 1 460  ) 

100 

(1461) 

(1462) 
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COMMON  BLOCK  FOR  THE  ORAW-EO  FILE 

COMMON  DRAW,TIT»PTIT»OTtSYS»VEHtSECT«NSHT»FREV*FNEO»FEOREF» 
1 drUi:.htn,rev,neo,eoref, 

1 FON.ETIT.EPTITf EOREV,EDT»ERDT,EOVEH, 

1 R*  IOFitINEOtKNT,FIRST*SFCOND»TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 


INTEGER*A 

1 

1 

INTEGER*2 

1 

1 


OF.A'J(A),TIT(21),PTIT{19),SYS(3),SECT(3),FEOREFaO,2), 

DFU(4),EOREF(10,2),fPTIT<19),FTIH21),EON(2), 

IDR(R),KNT,TTIT(19) 

DT(3)fVrH(2»2)tMSHT*SHTN<2),FREV»FNE0,REV»NEO, 
t OREVtEOT (3) ,ERDT<3) fE0VEH(2,2) ,R,INEO, 

FIRSTfSFCOND 


THIS  ROUTINE  LOCATES  ALL  DRAWINGS  WITH  A SPCIFIED  SYSTEM 

INTEGER*^  DS 
INTEGER‘2  ARRAYtlS) 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG 
IPAGE=0 

INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT  = 0 

URITEO,!) 

FORMATE*  WHAT  IS  THE  DESIRED  SYSTEM*) 

READE1,2,ERR=3)DS 

F0RMAT<3AA) 

REAO(6,END  = 200)ORAU,TIT  * P T I T , OT  t SYS , V EH , SECT *NSHT * FR EV t FNEO ♦ FEOREF 
DO  150  1=1.3 

IFEDS.EQ.SYSEI ) ) GO  TO  175 
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0 

1 


(lA6i) 

150 

CONTINUE 

(lAGD 

GO  TO  100 

( lAfi'j) 

175 

CONTINUE 

< l<i6ro 

C 

INCREMENT  THE  FOUND  COUNTER 

(lAiiT) 

KNT=KNT*1 

< 1A68> 

C 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

( H69) 

ILINE=ILIN[ ♦FNEO+NSHT+3 

( lATO) 

C 

CHECK  FOR  BOTTOM  OF  PAGE 

(1971) 

IF(ILINE.LE.95)  GOTO  31 

(197?) 

C 

SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

( l'(7i) 

IPAGCrO 

(1979) 

c 

SET  LINE  COUNTER  BACK  TO  0 

( 197‘j) 

ILINE=0 

(1976) 

c . 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1977) 

ILINE:FNE0+NSHT+3 

(1978) 

c 

IS  A HEADER  REQUIRED  NOU 

(1979) 

31 

IF(IPAGE.NE.O)  GOTO  190 

(1980) 

C 

INCREMENT  LINE  COUNTER  FOR  HEADER 

(1981 ) 

ILINE=ILINE*12 

(1982) 

C 

PRINT  HEADER  ON  PRINTER  OUTPUT 

(1983) 

C 

FETCH  AND  WRITE  TIME  AND  DATE  TO  OUTPUT  FILE 

( 1989  ) 

CALL  TIM0AT(ARRAY,15) 

(1985) 

AHIN=ARRA Y(9) 

(1986) 

AH=AMIN/60.0 

(1987) 

IH=AH 

(1988) 

IMM=IH»60 

(1989) 

IHIN=AMIN 

(1990) 

IDM=IMIN-IHM 

(1991  ) 

URITE(7.8008)IHtIOM,(ARRAY(I).I=l,3) 

( 199?  ) ■ 

8008 

FORHAT(»l*.100XtI3,*:*,I3t9X,2(A2,*/*),A2) 

(1993) 

URITF.(7,8000  ) 

(1999) 

8000 

FORMAT (3X  * 120  ( •*  •)  ) 

(1995) 

WRIT!  ( 7t8001  )DS 

(1996) 

8001 

FORMAT(95X,»  SYSTEM  SEARCH  I »,3A9) 

(1997) 

CALL  HEADER 

(1998) 

C 

SET  HEADER  DONE  FLAG 

(1999) 

IPAGE=1 

(1500) 

C 

DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 

) 


D-101 
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(1501) 

190 

CALL  DMAIN 

(1502) 

C 

INCREMENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

( 1503) 

ILINE=ILINE+INEO 

(150A) 

C 

IS  THE  PRINTER  AT  BOTTOM  OF  PAGE 

(1505) 

IF(ILINE.LE.A5)  GOTO  100 

(1506) 

c 

SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(1507) 

IPAGE=0 

(1508) 

c 

RESET  THE  LINE  COUNTER  TO  0 

(1509) 

ILINE=0 

(1510) 

GO  TO  100 

(1511  ; 

. 200 

WRITE(lt250)KNT,DS 

(1512) 

250 

F0R«AT(*  THERE  ARE  ’IS*  DRAWINGS  WITH  A SYSTEM  OF  »3AA) 

(1513) 

RETURN 

(151A) 

END 

\ 
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AH 

R 

000502 

1466M 

1487 

A«IN 

R 

00050A 
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1489 

ARRAY 
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000002 
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1484A 

1485 

1491 

DMAIN 
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EXTERNAL 

000000 
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DRAW. 

J 

// 

OOOOOO 

1443S 
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DRW 

J 

// 

00022& 
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14  62 

14  95 

DT 

I 

// 

000130 

1443S 
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EDT 

I 

// 

0O0A37 

14  43S 

■ ECN 

■ J 

// 
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1443S 

EOREF 

J 

// 

0002A2 

1443S 

EOREV 

I 

// 

000A36 

1443S 

EOVEH 

I 

// 

000AA5 

1443S 

E.PTIT 

J 

// 

000370 

1443S 

ERDT 

I 

// 
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1443  S 

EMT 

J 

// 

000316 

1443S 

E EOREK 

J 

n 

000156 

1443S 

1460H 

0 

1 

FIRST 

i 

it 

00OA65 

1*43S 

o 

FNEO 

I 

// 

000155 

14*3S 

1460K 

1469 

1477 

ro 

FREV 

I 

// 

00015A 

144  2S 

1460M 

HEADER 

R 

EXTERNAL 

000000 

1497 

I 

I 

000510 
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1462 

14  91H 

I DM 
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000511 

1490M 

1491 

IDR 

J 

// 

000A52 

1443S 

IH 

I 

000512 

1487M 

1488 

1491 

IlINE 
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000513 

1453H 

1469H 

1471 
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1505 

1509M 

IMIN 

1 

000514 

1489H 

1490 

TMM 

I 

000515 

1 4 8 8 H 

1490 

INEO 

I 

// 

000462 

1443S 

1503 

iPAGE 

I 

000516 

1451M 

1473M 

1479 

1499H 

KNT 

J 

// 

ODD  463 

1443S 

1455H 

1467H 

1511 

NEO 

I 

// 

0.00  24  1 

1443S 

NSHT 

I 

// 

000153 

1443S 

146DH 

1469 

1477 

PTIT 

J 

// 

000062 

1443S 

1460H 

R 

1 

// 

000451 

1443S 

REV 

I 

// 

000240 

1443S 

SECOND 

I 

// 

000466 

1443S 

TAGE  0100 


1511 


1A77H  1481H  .1.503M 


1507M 
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sect 

J 

)i 

000145 

1443S 

1460H 

SHTN 

I 

// 

000236 

1443S 

SYS 

J 

// 

000133 

1443S 

1460M 

SYSDW 

R 

000000 

1442S 

TIMDAT 

R 

EXTERNAL 

000000 

1484 

TIT 

J 

// 

000010 

1443S 

1460M 

VTIT 

J 

// 

000467 

14  43S 

VEH 

I 

// 

000141 

1443S 

1460M 

000040 

1456 

14570 

_10t) 

000076 

14600 

1464 

..150 

000164 

1461 

14630 

_175 

000173 

1462 

14650 

_190 

000414 

1479 

15010 

_2 

000072 

1458 

14590 

I2OO 

000431 

1460 

15110 

250 

000444 

1511 

15120 

_3 

000033 

14560 

1458 

_31 

000224 

1471 

14790 

_8000 

000347 

1493 

1494D 

_6C01 

000366 

1495 

14960 

_8008 

000320 

1491 

14920 
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(1515) 
(151S)  C 
(1516)  C 
(1516)  C 
(1516) 
(1516) 
(1516) 
(1516) 
(1516)  C 
(1516)  C 
(1516)  C 
(1516) 
(1516) 
(1516) 
(1516) 
(1516) 
(1516) 
(1516)  C 
(1516)  C 
(1517)  C 
(1518)  C 
(1519)  C 
(1580)  C 
(1521)  C 
(1522) 
(1525) 
(152A>  C 
(1525) 
(1526)  C 
(1527) 
(1528)  C 
(1529) 
(1530)  3 

(1531)  1 

(1532) 
(1533)  2 

(153A) 
(1535)  100 


SUBROUTINE  DRAWN 

COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 


COMMON  DRAU»TIT,PTIT,DT,SYS,VEH»SECT»NSHT,FREV*FNEO»FEOREFt 
1 DRU,SHTN,REV»NEOtEOREFt 

1 EON.ETIT»EPTIT,EOREVtEDT,ERDT.EOVEH» 

1 R»IOR,INEO,<NT«FIRST,SECOND»TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 


INTEGER*A 

1 

1 

INTEGER*2 

1 

1 


DRAW(4) ,TIT(21 ) » PT I T ( 1 9 ) , S YS( 3 ) i SECT( 3 ) , FEOREF( 1 0 t 2 ) » 
DRU(A)»EOREF(10.2),EPTIT(19) ,ETIT(21),E0N(2)» 
IDR(R)»KNT,TTIT(19) 

DT( 3) .VEH (2»2) ,NSHT,SHTN(2) ,FREV*FNEOf REVfNEOt 
E0REVt5DT(3) ,ERDT(3) ,EOVEH(2»2) ,R,LNEO» 

FIRST, SECOND 


THIS  ROUTINE  LOCATES  A DRAWING  WITH  A SPECIFIED 
DRAW-EO  NUMBER 

INTEGER*^  IDRAW(A) 

INTEGER*2  ARRAY(15) 

INITIALIZE  THE  TOP  OF  PRINTER  PAGE  FLAG. 

IPAGE=0 

INITIALIZE  THE  LINE  COUNTER  FOR  PRINTER  OUTPUT 
ILINE=0 

INITIALIZE  THE  FOUND  COUNTER 
KNT=0  • 

WRITEd.l) 

FORHAT(*  WHAT  IS  THE  DESIRED  DRAWING  NUMBER*/) 

REA0(1,2,ERR  = 3)  IDRAW 
F0RMAT(3AA,A2) 

WRITE(1,2)IDRAW 

READ(6,END=200 )DRAU,TIT,PTIT,DT,SYS,VEH,SECT,NSHT,FREV,FNEO,FEOREF 


J 


) 
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(1536J 

DO  1000  I=lt9 

(1537) 

IF(IDRAW(I).NE.DRAW(I))  GO  TO  100 

(1538) 

1000 

CONTINUE 

(1539) 

c 

INCREMENT  THE  FOUND  COUNTER 

(1590) 

KNT=KNT+1 

(1591) 

c 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1592) 

ILINE=ILINE+FNE0+NSHT+3 

(1593) 

c 

CHECK  FOR  BOTTOM  OF  PAGE 

(1599) 

IF(  ILINE.LE.95)  GOTO  31 

(1595) 

c 

SET  TO  TOP  OF  PRINTER  PAGE  FLAG 

(1596) 

IPAGE=0 

(1597) 

c 

SET  LINE  COUNTER  BACK  TO  0 

(1598) 

ILINE=0 

(1599) 

c 

INCREMENT  LINE  COUNTER  FOR  NEXT  RECORD 

(1550) 

ILINE=FNE0+NSHT+3 

(1551  ) 

c 

is  A HEADER  REQUIRED  NOW 

(1552) 

31 

IF(IPAGE.NE.O)  GOTO  150 

(1553) 

C 

INCREMENT  LINE  COUNTER  FOR  HEADER 

(1559) 

ILINE=ILINE+12 

(1555) 

C 

PRINT  HEADER  ON  PRINTER  OUTPUT 

(1556) 

C 

FETCH  AND  WRITE  TIKE  AND  DATE  TO  OUTPUT  FILE 

(1557) 

CALL  TIMDAT(ARRAY,15) 

(1558) 

AHIN=ARRAY(9) 

(1559) 

AH=AMIN/60.0 

(1560) 

IH-AH 

(1561) 

IHM=IH*60 

(1562) 

IHIN=AMIN 

(1563) 

IDM=IMIN-IMM 

(1569) 

WRITE! 7*8008 )IH»IDH, (ARRAY! I )tl=l»3) 

(1565) 

8008 

FORMAT(*1',100X,I3.*:*,I3,9X*2(A2«*/»)*A2) 

(1566) 

WRITE(7,800C) 

(1567) 

8000 

FORMAT (3X*120 ( »* • ) ) 

(1568) 

WRITE(7,8001)IDRAW 

(1569) 

8001 

F0RMAT(95X,»  DRAWING  NUMBER  SEARCH  : •*3A9,A2) 

(1570) 

CALL  HEADER 

(1571) 

C 

SET  HEADER  DONE  FLAG 

(1572) 

IPAGErl 

(1573) 

C 

DISPLAY  AND  PRINT  DRAWING  ON  TERMINAL  AND  PRINTER  OUTPUT 
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(157A)  150  CALL  CHAIN 

(1575)  C INCREHENT  LINE  COUNTER  FOR  DRAWING  RECORD  PRINTED  FOR  OUTPUT 

(1576)  ILINE=ILINE+INEO 

(1577)  C IS  THE  PRINTER  AT  POTTOH  OF  PAGE 

(1578)  IF<ILINE.LE.45)  GOTO  300 

(1579)  C SET  TO  TOP'  OF  PRINTER  PAGE  FLAG 

(1580)  IPAGE=0 

(1581)  C RESET  THE  LINE  COUNTER  TO  0 

(1582)  ILINE=C 

(1583)  . GO  TO  300 

(1584)  200  WRITE(1,250) IDRAW 

(1585)  250  FORHATE*  THERE  IS  NO  DRAWING  WITH  NUMBER  »3A4tA2*/» 

(1586)  1 * IN  THE  DRAWING  FILE*/) 

(1587)  300  RETURN 

(1588)  END 
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REV 
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// 
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EXTERNAL 

000000 

1557 

TIT 

J 

// 

000010 

1516S 

1535M 

TTIT 

J 

It 

000467 

1516S 

VEH 

I 

1 1 

000141 

1516S 

1535M 

_1 

000050 

1530 

1531D 

“lOC 

000122 

15350 

1537 

1000 

000213 

1536 

1538D 

_150 

000451 

1552 

1574D 

_2 

000106 

1532 

1533D 

1534 

200 

000466 

15  35 

1584D 

_2E,0 
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<1SB9)  SUBROUTINE  REVSDW 

(1590)  C 

(1590)  C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

(1590)  C 

<1590)  COMMON  DR AU , TI T »PT I T ,DT , S YS, VEH ♦ SECT* NSHT ♦ FRE V tFNEO » FEOREF » 

(1590)  1 DRW*SHTN,REV,NE0,E0REF, 

(1590)  1 EON,ETIT*EPTIT»EOREV,EDT»ERDT»EOVEH, 

(1590  ) 1 R«IDR»INEO,KNT, FIRST, SECOND, TTIT 

(1590)  C 

0590)  C DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 

(1590)  C 

(1590)  INTEGER»A  DR A W ( 9 ) , T I T ( 2 1 ) , PT I T ( 1 9 ) , S YS ( 3) , SECT ( 3 ) ,FEOREF ( 1 0 , 2 ) , 

(1590)  1 CRW(9),EOREF(10,2),EPTIT(19),ETIT(21),EON(2) , 

(1590)  1 IDR(9),KNT,TTIT(19) 

(1590)  INTEGER *2  DT(3),VEH(2,2),NSHT,SHTN(2),FREV,FNE0,REV,NE0, 

/ (1590)  1 E0REV,EDT<3),ERDT(3),E0VEH(2,2),R,INE0, 

(1590)  1 FIRST, SECOND 

(1590)  C 
(1590)  C 

(1591)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(1591)  NOLIST 

(1592)  C 

(1593)  INTEGER*^  IDR AW ( 9 ) , I EO ( 2 ) 

(1599)  INTEGER*2  I OPT , F I N ISH , A ( 15 ) 

(1595)  C 

(1596)  C THIS  IS  THE  REVISE  ROUTINE  FOR  THE  DRAU-EO  FILE 
(1597)  C 

(1596)  C VALIDATE  USER 

(1599)  CALL  TIMDAT(A,15) 

(1600)  IF(A(13).EQ.*JU».0R.A(13).EQ.»NH*.0R.A(13).EQ.*RJ».0R.A(13).EQ. 

(1601)  1*DK»)  GOTO  3 

(1602)  WRITE(1,9) 

(1603)  9 FORMATC  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.’,/, 

(1609)  1«  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT. 2621 

(1605)  l.») 

(1606)  RETURN 

(1607)  3 COtvTINUE 

(1608)  CALL  SRCHtJ (KSRDUR+KSNDAM, *REVS  *,6,9,1,10 
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(1609) 

IF(IC.NE.O)  GOTO  3000 

(1610) 

FINISH=0 

(1611) 

300 

URITE(1,301) 

(1612) 

301 

FORHAK*  00  YOU  WISH  THE  E.O.  OR  THE  DRAWING  FILE  (EO  OR  DRAW)*) 

(1613) 

READ(lt302) IANS 

(161't) 

302 

FORMAT(iAl) 

(1615) 

IFdANS.EG.'E*)  GOTO  31 

(1616) 

IF ( I AN3  .NE. »D* ) GOTO  300 

(1617) 

■ 5 

WRITEdfl) 

(1613) 

, 1 

F0RHaT(»  please  input  THE  SPO  DRAWING  NUMBER  OF  THE  *t/ 

(1619) 

1*  RECORD  TO  BE  RE V I SED* » / * * ! » 1 1 4 X, • ! • ) 

( 1620) 

READd  .2»ERR=5)  IDRAW 

(162,1) 

2 

FORMAT ( IX ,3A4 ,A2) 

(1622) 

REWIND  6 

(1623) 

100 

READ(6»rND=200)DRAy,TIT,PTITtOT,SYS,VEH,SECT»NSHT»FREV«FNEO»FEOREF 

CdE'i) 

IF(FINISH.FG.l)  GOTO  125 

(1625) 

00  1 10  1 = 1 , 4 

(1626) 

IFdORAWd)  .NE.DRAWd))  GO  TO  125 

r 1 

(1627) 

110 

CONTINUE 

(1623) 

CALL  SHCWDW 

(1529) 

WRITE(1,17C0) 

(1630) 

1700 

F0RMAT(/,1H0*/,*  IS  THIS  THE  CORRECT  RECORD  TO  BE  REVISED  OR  DFLET 

(1531) 

lED*,/,*  (YES  OR  NO)*) 

(1632) 

1800 

READ(1»50)I0PT 

( 1633) 

50 

FGRMAT(1A2) 

(1634) 

IFdOPT.EO.*NO*)  GOTO  125 

(1635) 

IF( lOPT.NE. * YE* ) GOTO  1700 

(1536) 

1900 

WRITE(1»2C00) 

(1637) 

2000 

FCRHAT(*  IS  THIS  RECORD  TO  BE  REVISED  OR  DELETED*^/, 

(1630 

1 • (REV  OR  DEL) •) 

(1639) 

READdtSO)  lOPT 

(1640) 

IF(IOPT.EQ.*RE*)  GOTO  120 

(1641) 

IF CIOPT.NE. *DE* ) GOTO  1900 

(1642) 

FINISH=1 

(1543) 

GOTO  1 'JO 

(1644) 

120 

R = 1 

(1645) 

CALL  IMPSDW 

(1646) 

119 

WRITE(ltl22) 

iii-a 
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(16A7) 

REAb(l»50)lCPT 

(1648) 

IFdOPT.EQ.'RE*  ) GOTO  120 

(16A9) 

IF(IOPT.NE.»CO*)  GOTO  119 

(1650) 

FINISH=1 

<1651 ) 

125 

URI7E(6)3RAU,TIT«PTIT»DT,SYS»VEH»SECT«NSHTtFREVfFNE0tFE0REF 

(1652) 

GO  TO  100 

(1653) 

200 

ENDFILE  8 

(165A) 

CALL  SRCHiS(K$CLOS* ’DRAW  '«6»0t0,0) 

(1655) 

CALL  SRCHSS(K$DELE, ‘DRAW  *»6»0,0t0) 

(1656) 

CALL  CrJAM$$<  *REV3  »,6**DRAW  •,6tIC) 

(1657) 

CALL  SRCH$$(K$RDWR+K$NDA«, ‘DRAW  »,6*2*1»IC) 

(1653) 

RETURN 

(1659) 

3000 

URITE(1,3001) 

(1660; 

3001 

FORMATdX, 'SORRY,  FILE  IS  IN  USE.  TRY  AGAIN  LATER.') 

(1661 ) 

RETURN 

(1662) 

C 

(1663) 

C 

BEGIN  THE  E.O.  SUBFILE  REVISION  ROUTINE 

(166A) 

C 

(1665) 

31 

URITE(1,11) 

(1666) 

11 

FCRMATC  PLEASE  INPUT  THE  SPO  EO  NUMBER  OF  THE  ',/ 

(1667) 

1'  RECORD  TO  BE  REVISED'/) 

(1668) 

READ<  1,21  ,ERR=31) lEO 

(1669) 

21 

FORHAT( 1AA.1A2) 

(1670) 

REWIND  18 

(lo71) 

101 

READ(18,END=201)EON,ETIT,EPTIT,EOREV,EDT,ERDT,EOVEH 

(1672) 

IF(FINISH.EQ.l)  GOTO  126 

(1673) 

DO  111  1=1,2 

(167A) 

IF ( IEO(  I) .NE.EON( I) ) GO  TO  126 

(1675) 

111 

CONTINUE 

(1676) 

CALL  SHOWED 

(1677) 

WRITEd  ,1700) 

(1678) 

1801 

READ(1,50)I0PT 

(1679) 

IF(IOPT.EQ.'NO')  GOTO  126 

(1680) 

IF(IOPT.NE.'YE')  GOTO  1801 

(1681) 

1901 

URITE(1,2000) 

(1662) 

READ(1,50)  lOPT 

(1683) 

IFdOPT.EQ.'Rt')  GOTO  121 

(166**) 

IF(ICPT.NE.'DE')  GOTO  1901 
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(16B5) 

FlNISHrl 

<168t.> 

GOTO  101 

(1687) 

121 

R = 1 

(1638) 

CALL  INPSE 

(1689) 

FlNISHrl 

(1690) 

123 

URITE (1»122) 

(1691) 

122 

F0RKAT(1H0^/,1X,»CHECK  RECORD:  IF  CORRECTt* 

(1692) 

1»  ENTER  ( CO) *,/fl6Xi *IF  REVISE  NEEDED*  ENTER  (RE)*) 

(1693) 

READdtSO)  lOPT 

(169A) 

. 

IF(IOPT.EO.*RE*)  GOTO  121 

(1695)  , 

IF(ICPT.NE.*CO»)  GOTO  123 

(1696) 

126 

URITE(8)EDN,ETITtE:PTITtEOREV*EDT,ERDT»EOVEH 

(1697) 

GO  TO  101 

(1698) 

201 

ENDFILE  8 

j 

(1699) 

CALL  SRCH$$ (KSCLOS* *EO  **6»0*0*0) 

1 

(17C0) 

CALL  SRCH$S(K$DELE* *EO  *,6»0«0i0) 

(1701) 

CALL  CNAH$$(*REVS  *,6**E0  *,6*IC) 

(1702) 

CALL  SRCH$$ (KSRDUR+KSNDAH* »EO  »»6»14*1*1C) 

(1703) 

C 

(1709) 

C 

(1705) 

C 

(1706) 

RETURN 

(1707) 

END 

) 
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I 
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I 
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I 

PARAMETER 
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PARAMETER 
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0 
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(1703) 

(1709) 

C 

(1709) 

c 

(1709) 

c 

(1709) 

(17.'i9) 

(1709) 

d/P9) 

(17C9) 

c 

(17f.9) 

c 

(1709) 

c 

(1709) 

(17(9) 

(1703) 

(1709> 

(17C?) 

(1709) 

(1709) 

c 

(1709) 

c 

(1710) 

c 

(1711) 
(1712) 
( 1 ■'  1 3 ) 

10 

(171A) 

(1.15) 

20 

(1716) 

(1717) 

(1718) 

30 

(1719) 

(1720) 

(1721) 

35 

(1722) 

(1723) 

(172A) 

(1725) 

(1726) 

36 

(1727) 

(1723) 

81 

SUBROUTINE  SHOUOU 

COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

COMMON  DRAW,TITf3TIT,DT,SYS,VEH,SECT»NSHTiFREV*FNE0fFE0REF» 

1 DRU»SHTN,REV,NEO«EOREF» 

1 EON,ETIT,EPTIT»EOREV,EDTtERDT,EOVEHf 

1 R» ICR,INEO.KNTtFIRST»SECONOtTTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

INTEGER*^  DRAU(A).T1T(21)»PTIT(19),SYS<3),SECT(3)»FEOREF(10*2)* 
1 DRW(4),E0REF(10,2)»EPTIT(19),ETIT(21),E0N<2)t 

1 IDR(R)»KNT,TTIT(19) 

INTEGER *2  0T(3),VEH(2,2),NSHT»SHTN(2)«FREV«FNE0*REV»NE0, 

1 E0REV,EDT(3),CR0T<3),E0VEH(2,2)tR,INE0» 

1 FIRST, SECOND 


CALL  CLEAR 
URITEdtlO)  PTIT 

F0RMAT(2X,n.  T I T LE  : * , / , 3X,  19A  A ) 

WRITE(1,20)DRAU,DT,SYS 

FGRMAT<2X,»2.  • , 3 A A , A2 , 3X , *3 . ♦ ,2 ( 12 , *-» ) , 1 2 , 7X, 

IM.  »,3(1X,AA)) 

URITEd ,30) < ( VEH(I,J) ,J  = 1,2) ,1  = 1,2)  ,SECT,NSHT 
F0RMAT(2X,»5.  • , 2 ( 1 X, 1 3 ♦ A1 , 1 X) , 5X,  • 6.  •,3AA,3X,*7.  »,I2, 

!♦  SHEETS* ) 

WRITE(1,35)FREV 

FORMAT(2X,»8.  SHEET#  1*,6X,*REV  »,A2) 

URITEd  ,70) 

IF(FNEO.NE.O)  GOTO  36 
URITEd, 72) 

GO  TO  81 
DO  81  J=l,FNEO 

URITEd,85)(FE0REF(J,K),K  = l,2) 

CONTINUE 
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n V29) 

IF(NSHT.EQ.l)  GOTO  300 

tlTiO) 

REUIND  12 

(1731) 

00  100  L=2»NSHT 

(1732> 

40 

REAO(12»END=150)  DRW tSHTN ,REV tNEO * EOREF 

(1733) 

00  50  1=1,4 

( 173-)) 

IF (DRAU ( I ) .NE.DRU(  I ) ) GOTO  40 

(173t) 

50 

CONTINUE 

(1736) 

IF(SHTN(2) .EQ.O)  GOTO  55 

(1737) 

URITE(1,52)(SHTN(K),K=1,2),REV 

(1738) 

62 

F0RHAT(2X,*8.  SHEET#  • , 1 2 , • . * , 12 , 3X, »REV  ♦ , A2) 

(1739) 

GO  TO  65 

(17'til) 

55 

URITE(1,60)  SHTN(1),REV 

( 17<> ) ) 

80 

F0RMAT(2X,*8.  SHEET#  •»I2,6X,*REV  »,A2) 

(17-*2) 

65 

URITE(1,70) 

(1  7‘.3) 

70 

F0RMAT(2X, »9.  REFERENCED  E.O.*»S») 

(174^1) 

IF(NEO.NE.O)  GOTO  75 

(17't5) 

URITE(1,72) 

72 

F0RHAT(6X, ‘NONE*) 

(17-''7; 

GO  TO  100 

(i7-;8) 

75 

DO  80  J=l,NEO 

(17v9J 

URITEd ,85) (E0REF(J,K),K=1,2) 

(175t) 

85 

F0RHAT(6X,1A4,1A2) 

(17317 

80 

CONTINUE 

(1752) 

100 

CONTINUE 

(1753) 

GO  TO  200 

(1754) 

150 

WRITE(1,160)  ORU 

(1755) 

160 

FORMAT!*  THERE  IS  AN  ERROR  IN  THE  NUMBER  OF  SHEETS  FOR*,/, 

(17ft) 

1*  DRAWING  »,3A4,A2) 

(1757) 

200 

READ(12,END  = 300)  DR W , SHTN , RE V , NEO ,EOREF 

(1758) 

GO  TO  200 

(l',59) 

300 

CONTINUE 

(1780) 

RETURN 

(17bl) 

END 
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(17r,3) 
(1/63' 
(1763) 
(1/63) 
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SUBROUTINE  SHOWED 

COHMON  BLOCK. FOR  THE  DRAU-EO  FILE 

COMMON  DRAUfTIT,PTIT,DT,SYS,VEH,SECTtNSHT»FREV,FNEOtFEOREF, 

1 ORU4SHTN,REVfNEO*EOREF, 

1 EON,ETIT,EPTITtEOREV,EDT,ERDT»EOVEH» 

1 R«IDR»INEO*KNTtFIRSTtSECOND»TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 

INTEGER*^  DRAW(A),TIT(21)»PTIT(19),SYS(3)*SECT(3)»FEOREF(10t2)» 
1 DRW(A),E0REF(10»2),EPTIT(19)tETIT(21)tE0N(2)* 

1 IDR(A),KNT,TTIT(19) 

INTEGER *2  DT(3) . V EH  ( 2 , 2 ) , NSHT ,SHTN (2 ) » FREV « FNEO * RE V , NEO t 
1 rOREVtEDT(3) tERDT(3) ,E0VEH(2.2) ,P,INEO* 

1 FIRST«SECOND 


CALL  CLEAR 

URITEdflO)  EPTIT 

F0RHAT(2X,»1.  TI TLE I • . / , 3X» 19 A4 ) 

URITE(l,20)EON,EOREVtEDT 

F0RMAT(2X,»2.  *,2A4,5X,»3.  •»A2*5X,*4.  • , 2 ( 12 t * -• ) , 12 ) 

WRITE(lf30)ERDTt( (EOVEH (If J)tJ=l,2) ,1=1,2) 

F0RHAT(2X,*5.  • , 2 ( 1 2 , • - • ) , 1 2 , 5 X , * 6 . • , 2 ( 13, A 1 , 1 X) ) 

RETURN 

END 
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(177A) 
(177b)  C 
(1775)  C 
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(1775) 
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SUBROUTINE  CHAIN 

COHHON  BLOCK  FOR  THE  ORAU-EO  FILE 

COHHON  ORAU«TIT,PTIT,CTtSYStVEH,SECT»NSHTtFREV»FNEO»FEOREF« 
1 ORW,SHTN,REV«NEO»EOREF, 

1 EON,ETIT,EPTITtEOREV,EOT,EROT»EOVEH» 

1 R* IDRtINEOtKNT, FIRST, SECOND, TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 


INTEGER*^ 

1 

1 

INTEGER*2 

1 

1 


DRAW( A) ,TIT(21) ,PTIT (19) ,SYS(3),SECT(3),FEOREF(10,2)  , 
DRU(A),EOREF(10,2),EPTIT(19),ETIT(21),EON(2), 

IDR(A) ,KNT,TTIT(19) 

DT(3) ,VEH(2,2) ,NSHT,SHTN(2),FREV,FNE0,REV,NE0, 
EOREV,EDT(3) ,ERDT(3) ,E0VEH(2,2) ,R, INEO, 

FIRST, SECOND 


INTEGER*2  EOKNT,II 


THIS  IS  THE  BASIC  OUTPUT  ROUTINE  FOR  THE  SPOOLER  AND  TERMINAL 

INEO=0 

EOKNT=l 

URITE(1,998) 

FORHAK//) 

FORHAT(IHO) 

URITE(7,999) 

URITE(1,100)KNT,PTIT 

F0RHAT(1X,I9,».  DRAWING  T ITLE » ,/ , 3X , 19A4 ) 

WRITE(1,120)DRAU,DT 

FORHAK lOX, ’DRAWING  NUMBER  » , 3 A A , A2 , 3X, »DA TE  » ,2 ( 1 2 ,»-»), 1 2) 
WR ITE ( 7,220 )KNT,?T IT, DRAW,  DT 

FORHATdX,  18,  •.  » , 1 9 AA  ,3  X , 3 AA  , A2 , 8X,  2 ( 1 2,  ♦ -•  ) , 1 2 ) 

WRITE(1,231)  FREV 
WRITE(7,231)  FREV 


J 


) 


) 
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231 

FORHAK  llXt'SHEETK  l*,flXt*REV  *,A2) 

(1796) 

IF  (FNEO.EQ.O)  GOTO  301 

(1797) 

IF(R.E3.0)  GO  TO  32 

(1798) 

H = FNE0 

(1799) 

IF(FNEO.GT.IO)  11=10 

(18  0 0 

00  35  1=1,11 

( 180  U 

IF(FE0REF( I, 1) .EQ. * •)  GOTO  301 

(1302) 

URITE(1,38)  I,(FE0REF(I,K),K=1,2) 

(1803) 

UR  IT E( 7,38)  I, (FE0REF(I,K),K  = 1,2) 

(18CA) 

38 

F0RHAT(11X,I2,».  »,2A4) 

(1SC5) 

35 

CONTINUE 

(13C6) 

GO  TO  301 

(18C  7) 

32 

II=FNE0 

( 1803) 

IF(FNEC.GT.IO)  11=10 

(18095 

DO  301  1=1,11 

(1810) 

31 

READ( 18,END=91)E0N,ETIT,EPTIT,E0REV,EDT,ERDT,E0VEH 

(18U  ) 

C 

SEARCH  FOR  EOREF=EON 

(1812) 

DO  901  N=l,2 

o 

(1813) 

IF(EON(N) .NE.FEOREF ( I,N) > GOTO  31 

1 

(1819) 

901 

CONTINUE 

ro 

cn 

(lai 5) 

IF(E0R£V.E0.*NC»)  GOTO  151 

(1816) 

UftITE(7,230)EOKNT,EON,EOREV,ERDT,EPTIT 

(1817) 

WRITE (1,1 90 )EOKNT,EON,EOREV,ERDT 

(1818) 

GO  TO  61 

(1819) 

151 

URITE(7,290)EOKNT,EON,EOREV,EDT,EPT1T 

(1620) 

URITE(1,190)EOKNT,EON,EOREV,EDT 

(1821) 

61 

E0KNT=E0KNT+1 

(1622) 

IF(EPTI T( 1 ) .NE. • ♦)  URITF(1,130)EPTIT 

(1823) 

91 

REWIND  18 

(1320 

301 

CONTINUE 

(1825) 

IF (NSHT.EQ. 1)  GOTO  190 

(1626) 

DO  190  K=2,NSHT 

(1827) 

E0KNT=1 

(1828) 

160 

READ(12,END=190)DRU,SHTN,REV,NEO,EOREF 

(1829) 

DO  170  J=l,9 

(1830) 

IF(DRU( J) .NE.DR AU(J) > GOTO  160 

(1831) 

170 

CONTINUE 

(1832). 

IF(SHTN(2).E0.0)  GOTO  265 

D-126 
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(1833) 

WRITE(1»260) (SHTN(J),J=1,2),REV 

(1834) 

URltE( 7.260) (ShTN(J)«J=l,2) »REV 

(1835) 

260 

FOR  HAT (1 IX, 'SHEETS  »,I2,».'.I2,5X.'REV  ',A2) 

(1836) 

GO  TO  275 

(1837) 

265 

URITE(1.270)  SHTN(1),REV 

(1838) 

V!RITE(7,270)  SHTN(1),REV 

(183S) 

270 

F OR MAT(1 IX, 'SHEETS  ',I2,8X,'REV  ',A2) 

(1840) 

275 

CONTINUE 

(1341) 

INEO=INEO+NEO 

(1842) 

IF(NEO.EO.O)  GOTO  190 

( 1 8 3 ) 

IF(R.EQ.O)  GOTO  33 

(1844) 

II=NEO 

(1845) 

IF(NEO.GT.IO)  11=10 

(1346) 

DO  37  1=1,11 

(1847) 

IF(EOREF(I,l).Ea.'  ')  GOTO  300 

(1848.' 

WRITE(1,38)  I, (EOREF( I ,K) ,K  = 1,2) 

(1849) 

URITE(7,38)  I,(E0REF(I,K),K=1,2) 

(1850) 

37 

CONTINUE 

(1851 ) 

GO  TO  300 

(1652) 

33 

II=NEO 

(1853) 

IF(NEO.GT.IO)  11=10 

(1854). 

DO  300  1=1,11 

(1855) 

30 

READ(18,END=90)EON,ETIT,EPTIT,EOREV,EDT,ERDT,EOVEH 

(1856) 

C 

SEARCH  FOR  EOREF=EON 

(1657) 

DO  400  N=l,2 

(1858) 

IF(EON(N) .NE.EOREF( I ,N) ) GOTO  30 

(1859) 

400 

CONTINUE 

(I860) 

130 

FCRHAT(3X,19A4) 

(186.1) 

IF(EOREV.EG.'NC')  GOTO  150 

(1862) 

URITE(7,230) EOKNT,EON,EOREV,ERDT,EPTIT 

(1863) 

230 

F0RHAT(11X,I2,'.  ' , 2 A4 , 1 X , ' R E V ' , A2 , 3X ,2 ( 12 , ' -» ) , 12 , 

(1864) 

13X.19A4) 

(1865/ 

WRITE(1,140)EOKNT,EON,EOREV,ERDT 

(1866) 

140 

F0RMAT(11X,I2,'.  ' , 2 A4 , 1 X , ' RE V ' , A2 ,5X  ,2 ( 12 , '- ' ) , 12 ) 

(1867) 

GO  TO  60 

(1868) 

150 

URITE(7,240) EOKNT,ECN,EOREV,EDT,EPTIT 

(1869) 

240 

F0RMAT(11X,I2,'.  ' , 2 A4 , 1 X , ' RE V ♦ , A2 , 3X , 2 ( 12 , '- ' ) ♦ 1 2 , 

(1876) 

13X.19A4) 

PAGE  Cia't 


D-127 


SUBROUTINE  DHAIN 


PAGE  0125 


(1871) 

WRITE ( 1, 140 )EOKNT«EON,E ORE  V, EOT 

(1372) 

60 

E0KNT=E0KNT+1 

(1373) 

IF(EPTIT(1).NE.*  •)  URITE(lfl30) EPTIT 

(1674) 

90 

REUINO  18 

(1875) 

300 

CONTINUE 

(1876) 

. 190 

CONTINUE 

(1877) 

REWIND  12 

(1878  . 

CALL  RECYCL 

(1879) 

CALL  PAUS 

(I860) 

• 

RETURN 

(1881.) 

END 
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CHAIN 

R 

000000 

1774S 

DRAW 

J 

// 

000000 

1775S 

1789 

1791 

1830 

ORU  ■ 

J 

// 

000226 

1775S 

1828M 

1830 

IT 

I 

// 

000130 

1775S 

1789 

1791 

EUT 

I 

// 

000437 

1775S 

1810H 

1819 

1820 

EOKNT 

I 

001674 

1776S 

178  2M 

1816 

1817 

1827H 

1862 

1865 

1868 

EON 

J 

// 

000312 

1775S 

1810H 

1813 

1816 

1855H 

1853 

1862 

1865 

EORfF 

J 

// 

000242 

1775S 

1828H 

1347 

1848 

EOREV 

I 

// 

000436 

1775S 

1810M 

1815 

1816 

18  55M 

1861 

1862 

1865 

EOVEH 

I 

// 

000445 

1775S 

1810M 

1855H 

F.PTIT 

J 

// 

000370 

1775S 

1810H 

1816 

1819 

1868 

1873 

ERDT 

I 

// 

000442 

1775S 

1810H 

1816 

1817 

ETIT 

J 

// 

000316 

1775S 

laiQ.M 

1S55M 

TECREF 

J 

// 

000156 

17753 

1801 

1802 

1803 

FIRST 

I 

// 

000465 

1775S 

FNEO 

I 

// 

000155 

1775S 

1796 

1798 

1799 

FREV 

I 

// 

000154 

17753 

1793 

1794 

I 

I 

001675 

18  0CH 

1801 

1802 

1803 

1847 

1848 

1849 

1854H 

IDR 

,J 

// 

000452 

1775S 

II 

I 

001677 

1776S 

1798M 

1799M 

' 1800 

1B44H 

1845H 

1846 

1852M 

INEO 

I 

// 

000462 

17753 

1781H 

1841H 

J 

I 

001700 

1829, H 

1830 

1833H 

1834M 

K 

I 

001701 

1P02.H 

1803H 

1826H 

1848H 

KNT 

J 

// 

000463 

17753 

1737 

1791 

N 

I 

001702 

1812H 

1813 

1857H 

1858 

NEO 

I 

// 

000241 

17753 

1828M 

1841 

1842 

1853 

NSHT 

I 

// 

000153 

17  75  3 

1825 

1826 

PAUS 

R 

EXTERNAL 

000300 

1879 

PTIT 

J 

// 

000062 

17753 

1787 

1791 

R 

I 

// 

000451 

17753 

1797 

1843 

RECYCL 

R 

EXTERNAL 

000000 

1878 

J 
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1855M 

1868 

1871 

1819  . 

1820 

1821H 

1871 

1872H 

1817 

1819 

1820 

1868 

1871 

1849 

1858 

1817 

1819 

1820 

1868 

1871 

1822 

1 855.1 

1862 

1855M 

1862 

1865 

1813 

1807 

1808 

1809M 

1813 

1846M 

1858 

1807H 

1808H 

1809 

1853H 

1854 

1849H 

1844  ■ 1845  ■ 1852 


) 
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REV 

i 

// 

C00240 

1775S 

1828M 

1833 

1834 

SECOND 

I 

// 

000466 

1775S 

SECT 

j 

// 

00014S 

1775S 

SHTN 

I 

// 

000236 

1775S 

1828H 

1832 

1833 

SYS 

j 

// 

000133 

1775S 

TIT 

j 

// 

000010 

1775S 

ITIT 

j 

// 

000467 

1775S 

VEH 

I 

// 

000141 

1775S 

_1C 

000065 

178SD 

IlOO 

000042 

178  7 

1788D 

_120 

000077 

1789 

1790D 

_130 

001351 

1822 

1860D 

1873 

_14  0 

001464 

1817 

1320 

1865 

18660 

_150 

001515 

1861 

1868D 

Il51 

000556 

1815 

1819D 

_iSC 

000666 

1828D 

1830 

Il70 

000735 

1829 

1831D 

_190 

001651 

1325 

1826 

1828 

1842 

_220 

000153 

1791 

1792D 

230 

001410 

1816 

1362 

18630 

231 

000220 

1793 

1794 

17950 

_240 

001540 

1819 

1868 

18690 

_2  60 

C01022 

1333 

1834 

13350 

„2.65 

001047 

1832 

1B37D 

_270 

001073 

1337 

1838 

18390 

I275 

001114 

1836 

1840D 

30 

C01261 

1855D 

1858 

_3Q0 

001641 

1847 

1851 

1854 

18750 

301 

000645 

1796 

1301 

1806 

1809 

000412 

1810D 

1813. 

~32 

000401 

1797 

1807D 

001250 

1843 

1852D 

000373 

1800 

1805D 

-37 

001240 

1346 

1850D 

_3  8 

000361 

1802 

1803 

18040 

1848 

I40C 

001343 

1857 

18590 

_4  01 

000474 

1812 

1814D 

u. 
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1837  1838 

1834  1837  1838 

1871 

1876D 


1824D 


1849 
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_so 

001615 

1867 

18720 

000621 

1818 

18210 

_'9  0 

001637 

1855 

18740 

0006A3 

1310 

18230 

_990 

000014 

1783 

17840 

~?99 

000017 

17850 

1786 

0000  ERRORS  C<DHAIN  >FTN-RE VI A . 2 3 
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(1882) 
(1883) 
(1883) 
(1883) 
(1883) 
(1883) 
(1883) 
(1833) 
(1833) 
(1883) 
(1383) 
(18.83) 
(1883) 
(18831 
(188.3) 
(1683) 
(1683) 
(1883) 
O (1883) 
(1838) 
Zi  (1885) 
— (1866) 
(1887) 
(1388) 
(1889) 
(1690J 
(1891) 
(1892) 
(1893) 
(189  A) 
(1895) 
(1896) 
(1897) 
(1896) 
(1899) 
(19C0) 
(1901) 
(1902) 


SUBROUTINE  HAIND 
C 

C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 
C 

COMMON  DRAW,TITtPTITfOT,SYS,VEH»SECTtNSHTtFREV»FNEO»FEOREF» 

1 DRU*SHTN,REVfNEO,EOREF* 

1 CONfETIT,EPTIT,EOREV,EDT,ERDT,EOVEH* 

1 R* IDR,INEO»KNT.FIRST»SECOND,TTIT 

C 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

C 

INTEGER*4 

1 
1 

INTEGER*2 

1 
1 
C 
C 

INTEGER*2  EOKNTtll 
C 
C 

C THIS  IS  THE  ACTION  DUE  OUTPUT  ROUTINE  FOR  THE  SPOOLER  AND  TERMINAL 
C 

E0KNT=1 

IFdNEO.EQ.l. AND. SECOND. EQ.l)  GOTO  222 
URITE(lt998) 

998  FORMAT!//) 

999  FORMAT(IHO) 

WRITE(7f999) 

URITE(l»100)KNTfPTIT 

100  FORHAT(lXtI9»».  DRAWING  T I TLE » , / * 3 X, 19 AA  ) 

10  URITE(ltl20)DRAUtDT 

120  FORMAT! 10X,»DRAUING  NUMBER  • 1 3 A4 , A2 , 3X » • DATE  • »2 ( 12 « * -• ) , 1 2 ) 
WRITE(7,220)KNT*PTITt0RAU*DT 
220  FORMAT! IXt 18» • . • » 1 9A A , 3 X t 3A4 » A2 i 8 X»2 ( 12 » • - • ) » 12 ) 

INE0=1 

IF(FIRST.EO.O)  GOTO  222 


DRAU(  A)  ,TIT(21 ) ,PTIT(19) ,SYS(3  ) »SECT(3) »FEOREF(10»2)  « 

DRU(A),EOREF(10,2)»EPTIT(19),ETIT(21)«EON(2), 

IPR(A),KNT,TTIT(19) 

DT(3)»VEH(2*2)*NSHT,SHTN(2)tFREV»FNE0»REV»NE0» 
EOREV,EDT(3) . ERDT ( 3) , EOVEH ( 2 * 2) , R , I NEO * 

FIRSTtSECOND 


SUBROUTINE  HAIND 


(1?03) 

UR1TE(1»160)FREV 

<’.90A> 

URITE(7tl60)FREV 

(19l)E) 

160 

FORHATdlX, ’SHEETS  1»,8X,»REV  »fA2) 

(1906) 

IF(R.EQ.O)  GOTO  32 

(1907) 

II=FNE0 

(1908) 

IF(FNEO.GT.IO).  11=10 

(1909) 

DO  35  I=1»II 

(1910) 

IF(FEOREF (I ,1) .EQ.»  »)  GO  TO  190 

(1911) 

URITE(1,38)  I*(FE0REF(I,K),K=1,2) 

(1912) 

WRITE(7t38)  I»(FE0REF(I,K)tK=lf2) 

(1913) 

38 

F0RMAT(11X,I2,*.  *,2A4) 

(1914) 

35 

CONTINUE 

(1915) 

GO  TO  190 

(1916) 

32 

II=FNEO  • 

(1917) 

IF(FNEO.GT.IO)  11=10 

(1918) 

DO  301  1=1,11 

(1919) 

31 

READ(18,END=91 )EON,ETIT,EPTIT ,EOREV,EDT,ERDT,EOVEH 

(1920) 

DO  401  N=l,2 

o 

(1921) 

IF(EON(N) .NE.FEOREF ( I,N) ) GOTO  31 

1 

(1922/ 

401 

CONTINUE 

(19;>3> 

IF(EOREV.EQ. *NC»)  GOTO  151 

■=5^ro 

(1924) 

WRITE(7,230)EOKNT,EON,EOREV,EROT,EPTIT 

(1925) 

WRITE (1 ,140 )EOKNT,EON,EOREV,ERDT 

(1926/ 

GO  TO  61 

(1927) 

151 

URITE(7,230)EOKNT,EON,EOREV,EDT,EPTIT  , 

(1928) 

WRITE! 1,14 0)EOKNT,EON,EOREV,EDT 

(1929) 

61 

EOKNT=EOKNT+l 

(1930) 

IF(EPTIT(1).NE.»  •)  WRITE(1,130)EPTIT 

(1931) 

91 

REWIND  18 

(1932) 

301 

CONTINUE 

(1933) 

GO  TO  190 

(1934) 

222 

IF(SHTN(2).EQ.O)  GOTO  223 

(1935) 

WRITE(1,260) (SHTN(K),K=1,2),REV 

(1936) 

WRITE(7,260) SHTN,REV 

(1937) 

260 

F0RMAT(11X,»SHEETS  »,I2,*.*,I2,5X,*REV  *,A2) 

(1938) 

GO  TO  280 

(1939) 

223 

WRITE(1,270)  SHTN(1),REV 

(1940) 

WRITE(7,270)  SHTN(1),REV 

J ; 
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(19A1) 

270 

F0RHAT(11X»»SHEET(!  »,I2,8X»»REV  *,A2) 

<19A2) 

280 

CONTINUE 

<1943) 

IF(R.Ea.O)  GOTO  33 

(1944) 

II=NEO 

(1945) 

IF(NEO.GT.IO)  11=10 

(1946) 

DO  37  1=1,11 

(1947) 

IF(EOREF(l,l).EO.»  *)  GOTO  190 

(1348) 

URITE(1,38)  I,(EOREF(I,K),K=l,2) 

(1949) 

WRITE(7,38)  I,(E0REF(I,K),K=1,2) 

(1930) 

37 

CONTINUE 

(1951) 

GO  TO  190 

(1952) 

33 

II=NEO 

(1953) 

IF (NEO.GT.IO)  11=10 

(1954) 

DO  300  1=1,11 

(1955) 

30 

READ(18,END=90)EON,ETIT,EPTIT,EOREV,EDT,ERDT,EOVEH 

(1956) 

C 

SEARCH  FOR  E0REF=E0N 

(1957) 

DO  400  N=l,2 

(1958) 

IF(EON(N).NE.EOREF(I,N>)  GOTO  30 

(1939)  . 

400 

CONTINUE 

(1960) 

130 

F0RHAT(3X,19A4) 

(1961) 

IF{EOREV.EQ.*NC»)  GOTO  150 

(1362) 

URITE(7,230)EOKNT,EON,EOREV,ERDT,EPTIT 

(1963) 

230 

F0RMAT(11X,I2,*.  • , 2 A4 , 1 X, • RE V » , A2 , 3X, 2 ( 12 , •-» ) , 12 , 

(19645 

13X,19A4) 

(1965) 

URITEd ,140)EOKNT,EON,EOREV,ERDT 

(1966) 

140 

F0RMAT(3X,I2, • . ♦ ,2 A4 , 1 X , ♦ RE V *, A2 , 5X,2 ( 12 ,♦-•), 12 ) 

(1967) 

GO  TO  60 

(1968) 

150 

U'RITE(7,230)EOKNT,EON,EOREV,EDT,EPTIT 

(1969) 

WRITEd ,140) EOKNT,EON,EOREV,EDT 

(1970) 

60 

EOKNT=EOKNT*l 

(1971) 

IF(EPTIT(1).NE.»  •)  URITEd, 130)EPTIT 

(1972) 

90 

REWIND  18 

( 1973) 

300 

CONTINUE 

(1974) 

190 

CONTINUE 

(1975) 

CALL  RECYCL 

(1976) 

CALL  PAUS 

(1977) 

RETURN 

(1978) 

END 
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DRAW 

U 

u 

000000 

1883S 

1897 

1899 

DRW 

U 

n 

C00226 

1883S 

DT 

I 

u 

000130 

1883S 

1897 

1899 

EOT 

I 

// 

000437 

1883S 

1919H 

1927 

1928 

1955M 

1968 

EOKNT 

I 

001525 

1884S 

1889H 

1924 

1925 

1927 

1928 

1962 

1965 

1968 

1969 

1970H 

EON 

J 

// 

000312 

18R3S 

1919M 

1921 

1924 

1925 

1927 

1955M 

1958 

1962 

1965 

1968 

1969 

EOREF 

J 

// 

000242 

1683S 

1947 

1948 

1949 

1958 

EOREV 

I 

// 

000436 

1883S 

1919M 

1923 

1924 

1925 

1927 

1955M 

1961 

1962 

1965 

1968 

1969 

EOVEH 

I 

// 

000445 

1BS3S 

1919M 

1955H 

-PTIT 

J 

// 

000370 

1883S 

1919H 

1924 

1927 

1930 

1955H 

1966 

1971 

ERDT 

1 

// 

000442 

1883S 

1919H 

1924 

1925 

1955M 
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ETIT 

J 

// 

000316 

18S3S 

1919M 

1955H 

FEOREF 

J 

// 

000156 
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FIPST 

I 

// 

000465 
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o 

FNEO 

I 

// 
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FREV 

I 

// 

000154 

1883S 

1903 

1904 

I 

I 

001526 
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IDR 

J 

// 

000452 
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II 

.1 

001530 

1B84S 

1907M 
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1945H 
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I 

// 
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1883S 
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1901H 

1. 

I 

001531 

1911H 

1912H 

1935H 

1948H 
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KNT 

J 

// 

000463 

1883S 

1895 
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MAIND 
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001533 
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• 
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I 

// 

000241 
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I 

// 

000153 
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1976 

. 
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SECT 

J 

// 

000145 

SHTN 

I 

// 

000236 

SYS 

J 

// 

000133 

TIT 

J 

// 
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000510 

If>o 

001462 

_61 

000635 

_9  0 

OC1504 

-•^l 

000657 

1883S 

1B83S  1934  1935  1936  1939 

1883S 

1883S 

1883S 

1883S 

1897D 

1895  1896D 

1897  18980 

1930  19600  1971 
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_998  000025  1891 

_999  000030  1893D 

0000  ERRORS  C<HAIND  >FTN-REV1 A. 2 3 


1892D 

1894 
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(1979) 

(1980) 

C 

(1981) 

C 

(1982) 

C 

(1983) 

C 

(1984) 

C 

(1984) 

C 

(1934) 

(1984) 

(1984) 

(1984) 

(1984) 

C 

(1984) 

C 

(1964) 

C 

(1984) 

(1984) 

(1984) 

(1984) 

(1984) 

(1984) 

(1904) 

C 

(1984) 

C 

(1984) 

c 

(1985) 

(1986) 

(1967) 

(1988) 

200 

(1969) 

(1990) 

(1991) 

300 

(1992) 

400 

(1993) 

(1994) 

500 

(1995) 

(1996) 

600 

SUBROUTINE  HEADER 

THIS  SUBROUTINE  PERFORMS  A PRINT  OF  HEADER  INFORMATION  TO 
THE  OUTPUT  FILE  TO  BE  SPOOLED 


COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

COMMON  ORAW,TIT,PTIT,OT,SYS,VEH,SECTfNSHT*FREVtFNEO.FEOREFt 
1 ORU,SHTN»REV,NEOf EOREFf 

1 EON»E:TITtEPTIT»EOREV,EDT»ERDT*EOVEHf 

1 R« IDRt INEO iKNTtFIRST«SECOND«TTI T 

DATA  DECLARATION  BLOCK  FOR  THE  ORAU-EO  FILE 

INTEGER  *4  DR  A W ( 4 ) , T I T < 2 1 ) , PT I T ( 1,9 ) ♦ S YS  { 3 ) , S ECT  ( 3 ) »FEOREF(  1 0 1 2 ) * 
1 DRU(4),EOREF(10»2),EPTIT(19),ETIT(21),EON(2)t 

1 IDR<4),KNT,TTIT(19) 

INTEGER*2  DT< 3) t VEH ( 2 , 2 > , NSHT , SHTN ( 2 ) t FREV f FNEO t RE V , NEO, 

1 E0REV,EDT(3) ,ERDT(3) «E0VEH(2*2) ,R*INEO, 

1 FIRST,SECOND 


WR1TE(7*200) 

FORMAT ( 11X» *DR AWING  TITLE* f66X » • DR  AW ING  NUMBER  ’ 1 1 OX »•  DA TE * ) 
IF(R.EQ.l)  GOTO  400 
WRITE(7f300) 

F0RMAT(12X. ’SHEET  NUHBER*»/t 

113X,«E.0.  NUMBER»fl2X,»DATE*»6X,*E.O.  T I TLE » f / » 3 X. 120 ( » * • ) > 
GO  TO  600 
WRITE(7,500) 

FORMAT ( 12X, »SHEET  NUMBER *»/» 13X* » E. 0.  NUMBER*./*  • 

1 3X,120(»**)) 

RETURN 

END 


D-138 


SUBROUTINE  HEADER 


ORAU 

J 

// 

000000 

19B4S 

DRU 

J 

// 
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1984S 

DT 

I 
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// 
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FEOREF 
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FIRST 

I 

// 

000465 

1964S 
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I 

// 

000155 

1984S 

FREV 

I 

// 

000154 

1984S 

HEADER 

R 

000000 

1979S 

IDR 

J 

// 

000452 

1984S 

INEO 

I 

// 

000462 

1984S 

KNT 
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// 

000463 

1984S , 

NEO 

I 

// 

000241 

1984S 

NSHT 
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// 

000153 

1984S 

PTIT 

J 

// 

000062 
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F. 

I 

// 
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1984S 

1987 

REV 
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// 
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1984S 
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// 

000466 

1984S 
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1984S 

SHTN 
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// 
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1984S 

SYS 

J 

// 

000133 

1984S 

TIT 

J 

// 

000010 

1984S 

TTIT 

J 

// 

000467 

1984S 

VEH 

I 

// 

000141 

1984S 

_200 
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1985 

1986D 

I3OO 

000054 

1988 
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O 


A 


CO 

VO 


I 
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<199/’) 
(1998)  C 
(1998)  C 
(1998)  C 
(1998) 
(1998) 
(1993) 
(1998) 
(1998)  C 
(1998)  C 
(1938)  C 
(1998) 
(1998) 
(1998) 
(1998) 
(1998) 
(1998) 
(1993)  C, 
(1998)  C 
(1999) 
(2000)  C 
(2001)  C 
(2002)  C 
(2003)  C 
(2009) 
(2005)  C 
(2006)  C 
(20071  C 
(2008) 
(2009) 
(2010) 
(2011) 
.(2012)  © 
(2013) 
(201't)  9 

(2015) 
(2016) 
(20i7) 


SUBROUTINE  INPTDW 

COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

COMMON  DRAU, TIT, PTIT.DT, SYS, VEH, SECT, NSHT,FREV»FNEO,FEOREF» 

1 ORW,SHTN,REV,NEO,EOREF, 

1 eon,etit,eptit,eorev,edt,erdt»eoveh, 

1 R,I0R,INE0,KNT, FIRST, SECOND, TTIT 

DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 

DR  AW (A) ,TIT(21) ,PTIT(19),SYS(3),SECT(3) ,FEOREF(10,2>, 
DRW(A),EOREF(10,2),EPTIT(19),ETIT(21),E0N(2), 

IDR(A),KNT,TTIT(19) 

DT(3)  ,VEH(2,2),NSHT,SHTN(2),FREV,FNE0rREV,NE0, 
E0REV,EDT(3) ,ERDT(3),E0VEH(2,2) ,R,INEO, 

FIRST, SECOND 


INTEGER*2  A(15) 


INPUT  SUBROUTINE  FOR  THE  DRAW-EO  FILE 
CALL  CLEAR 

VALIDATE  THE  INCOMMING  USER 
FIRST=0 

CALL  BREAKS(.TRUE.) 

CALL  TIHDAT(A,15) 

IF(A(13).EQ.»JW«.0R.A(13).EQ.»NH».0R.A(13).EQ.»RJ*.0R.A(13).EQ. 

l’DK»)  GOTO  3 
WRITE(1,A) 

FORMAT(»  SORRY,  YOU  ARE  NOT  VALIDATED  TO  USE  THIS  MODE.’,/, 

1*  IF  IT  IS  NECESSARY,  PLEASE  CONTACT  SYSTEM  OPERATOR  AT  EXT. 2621 

1 • * ) 

RETURN  ■ . 


integer*^ 

1 

1 

INTEGER*2 

1 

1 
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0 

1 

-Pk 


O 


(2018) 

3 

CONTINUE 

(2019) 

200 

CALL  BREAKS!. FALSE. ) 

(2020) 

C 

(2021) 

C 

POSITION  THE  DRAW  FILE  TO  THE  END  OF  RECORD  MARK 

(2022) 

C 

(2023) 

2000  READ(6tEND=2001)ORAUtTIT*PTlT*DT»SYStVEH«SECTiNSHTtFREV»FNEOt 

(202h> 

1 FEOREF 

(2025) 

GO  TO  2000 

(2026) 

2001 

READ(18,END=2002) EON,ETIT»EPTIT*EOREVtEDTf ERDTtEOVEH 

(2027) 

GO  TO  2001 

(2028) 

2002 

REAO(12»END=2003)DRU,SHTN,REV»NEOtEOREF 

(2029) 

GO  TO  2002 

(2030) 

2003 

CONTINUE 

(2031V 

URITE(1,1) 

(2032) 

1 

FORMAT!*  WELCOME  TO  THE  DRAU-EO  FILE  INPUT  ROUTINE*./ 

(2033) 

1*  PLEASE  INPUT  INFORMATION  BETWEEN  EXCLAMATION  HARKS*./ 

(2034) 

2*  AND  LEFT  JUSTIFY  ALL  ENTRIES*./) 

(2035) 

1010 

R = 0 

(2  0.36) 

100 

WRITE(l.lOl) 

(2037) 

101 

FORMAT!*  IS  THIS  A DRAWING  OR  AN  E.O.  (DRAW  OR  EO)*/) 

(2038) 

REAO(1.1002)IANS 

(2039) 

IF(IANS.EQ.*D*)  GOTO  1020 

(2340) 

IF(IANS.NE.*E*)  GOTO  100 

(20415 

CALL  INPSE 

(2042J 

WRITE (18) EON. ETIT.EPTIT.EOREV.EDT.ERDT.EOVEH 

(20A3) 

12  0 

READ(12.£ND=1000) DRW.SHTN.REV.NEO.EOREF 

(2044) 

GO  TO  120 

(2045) 

1020 

CALL  INPSDW 

(2046) 

WRITE(6)DRAU.TIT.TTIT.DT.SYS.VEH.SECT.NSHT.FRE.V.FNE0.FE0REF 

(2047) 

1000 

WRITE(l.lOOl) 

(2046) 

1001 

FORMAT!*  IS  THERE  ANY  FURTHER  INFORMATION  TO  BE  INPUT*. 

(2049) 

1*  (YES  OR  NO)*/) 

(2050) 

READ(1.1002)IANS 

(2051) 

IF(IANS.EQ.*Y*)  GO  TO  1010 

(2052) 

IF(1ANS.NE.*N*)  GOTO  1000 

(2053) 

1002 

FORMAT(lAl) 

(2054) 

REWIND  6 

(2055) 

REWIND  12 

D-142 
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(2056) 

(2057) 

(2058) 


REWIND  18 

RETURN 

END 


cr 


) 


) 
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// 
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// 
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// 
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// 
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// 
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// 

000467 

VEH 
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1 

000335 

2031 

20320 

.100 

000445 

20360 

2040 
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2043 

20470 
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”iooi 
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2047 

20480 

_1002 
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(2059)  SUBROUTINE  INPSDW 

(2060)  C 

(2060)  C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 
(2060)  C 

<2060)  COMMON  DR AU t T IT ,PT I T , DT » S YS t VEH »S ECT tNSHT tFREV, FNEO t FEOREF • 

(2060)  1 DRU,SHTN,REV»NE0»E0REF. 

(2060)  1 EON»ETIT»EPTIT»EOREVf EDT,ERDTf EOVEHt 

(2060)  1 R«IDR»INEOtKNT«FIRST,SECONDtTTIT 

(2060)  C 

(2060)  C DATA  DECLARATION  BLOCK  FOR  THE  DRAW-EO  FILE 
(2060)  C 

<2060)  INTEGER*4  OR A U( 4 ) , T I T ( 2 1 ) , PT I T ( 1 9 ) , S YS { 3 ) , SECT ( 3 ) tFEOREF ( 1 0 » 2 ) * 

<2060)  1 DRW(4),EOREF(10,2).EPTIT(19),ETIT(21)»EON(2)t 

<2060)  1 IDR(4)»KNT»TTIT( 19) 

<2060)  INTEGER*2  OT ( 3 ) » VEH ( 2 » 2 ) » NSHT t SHTN ( 2 ) » FREV tFNEOt REV  * NEO » 

<2060  1 . E.0REV,ECT(3),ERDT(3),E0VEH(2,2),R,INE0, 

(2060)  1 FIRST«SECOND 

(2060)  C 

(2060)  C ‘ 

(2061)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  HAY,  1977 

(2061)  NOLIST  I 

(2062)  C 

<2063)  INTEGER*2  lER ( 3 ) , I OPT  , I EOUP ,NEWSHT ,F INI SH , I SHTN ( 2 ) 

(2064)  C 

(2065)  C THIS  ROUTINE  PROVIDES  THE  BASIC  I/O  FOR  THE 
(2066)  C DRAWING  SUBFILE  INPUT/REVISE  ROUTINES 

(2067)  C 

<2068)  C INITIALIZE  THE  UPDATE  E.O.*S  ON  REVISED  SHEET  FLAG 

(2069)  IEOUP=0 

(2070)  NEUSHT=0 

(2071)  IF(R.EQ.O)  GO  TO  100 

(2072)  2 URITEdtl) 

(2073)  1 FORMAT!*  HOU  MANY  ITEMS  DO  YOU  WISH  TO  REVISE  (MAX  OF  9)*,/) 

(2074)  REAO(1,10,ERR=2)IKNT 

(2073)  10  F0RMAT(I3) 

(2076)  IF(IKNT.LT.O)  GO  TO  2 

(2077)  IF(IKNT.GT.9)  GO  TO  2 

(2078)  . DO  3800  L OOP=l , IKNT , 1 
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PACE  OlAA 


!2079) 

5 

!2080) 

!2081) 

!2032) 

!2083) 

3 

!2084) 

9 

!2085) 

!20eb> 

!2087) 

!2088) 

!2089) 

11 

!2090) 

!2091) 

!2092J 

19 

!2093) 

!2C94) 

!2095) 

!2096) 

!2097) 

20 

!2C98) 

!2099) 

!210C) 

25 

!2101) 

!2102) 

C 

!2103) 

c 

!2104) 

c 

!2105) 

100 

!2106) 

103 

!2107) 

101 

!2108) 

!21C9) 

!2110) 

!2111) 

110 

!2112) 

!2113) 

102 

!2114) 

12115) 

!2116) 

105 

URITE(lt3) 

FORMAT! » INPUT  THE  ITEM  NUMBER  THAT  YOU  WISH  TO  REVISE**/) 
REAC(ltl0tERR=5)IR 
IF( IR.NE.8.AND.IR.NE.7)  GOTO  100 
IF(IR.EQ.B)  GOTO  19 
WRITEdtll) 

FORMAT!*  IS  THIS  A CORRECTION  OF  SHEET  ITEM;  ENTER  YES*./* 

1*  OR  IS  THIS  A NEW  SHEET  ENTRY  FOR  A DRAWING:  ENTER  NEW*) 
READ!1*25*ERR=9)I0PT 
IF!IOPT.EQ.*YE*)  GOTO  100 
IF!IOPT.NE.*NE*)  GOTO  9 
NEWSHT=1 
GO  TO  100 
WRITE!1.20) 

FORMAT!*  IS  THIS  A REVISION  ENTRY  FOR  A NEW  DRAWING  SHEET** 

1 * !YES  OR  NO)**/**  note;  A NO  ANSWER  INDICATES  A REVISION  ITEM 
1C0RRECTI0N.**/.7X* *A  YES  ANSWER  WILL  DELETE  ALL  E.0.**S  **  ' 
l*FOR  THIS  SHEET.*) 

REAO!l *25.ERR=19) lOPT 
F0RMAT!1A2) 

IF!IOPT.EQ.*NO*)  GOTO  100 
IF!IOPT.NE.»YE*)  GOTO  19 
IEOUP=l 

BEGIN  INPUT 

IF!R.EQ.l.AND.IR.NE.l)  GO  TO  200 
WRITE!1*101> 

FORMAT!’  !1)  TITLE  !7  WORDS  - 10  CHAR. ) * */ * T * * 76 X* * ! */ ) 
F0RHAT!1X*17AA*A2) 

LENrlO 

CALL  TINPUT!TIT*LEN) 

WRITE!1*102)TIT  . ' 

FORMAT!7! 1X,2A4*A2)/) 

WRITE!1*105)PTIT 
FORKAT!lXf 19A4) 

DO  104  1=1,19 
TTIT!I)=PTIT!I) 
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(2117) 
(2118) 
(2119) 
(2120) 
(2121) 
(2122) 
(2123) 
(2124J 
(2125) 
(2 .26) 
(2*27) 
(2128) 
(2121) 
(2jjo: 
(2ir>i) 
(2i:.2) 
(21.’,.1> 
(2134) 
(2135) 
(21865 
(2137) 
(2130 
(2139) 
(21‘ 0) 
(2141) 
(2142) 
(2143) 
<214*  ) 
(2145) 
(2146) 
(2147) 
(2148) 
(2149) 
(2150 
(2151) 
(2152) 
(2153) 
(2154) 


104 

200 

201 

202 

203 

400 

401 

402 

403 

500 

501 

502 


503 

900 

901 

902 

903 

2200 

2201 

2202 


CONTINUE 

IF(R.EQ.1.AN0.IR.NE.2)  GO  TO  400 
URITE(1*202) 

FORMAT!*  (2)  DRAWING  NUMBER •»/»•!*, 14X t •!• /) 

READ (1»203»ERR=201 ) DRAW 
F0RMAT(lX,3A4tA2) 

WRITE(1»203)DRAW 

IF(R.EQ.1.AND.IR.NE.3)  GO  TO  500 
URITE(1,402) 

FORMAT!*  (3)  DRAWING  D ATE  * t /§ * ! MMDDY Y ! • / ) 

READ(1,403»ERR=401)DT 

F0RMAT(lXt3I2) 

WRITE(1,403)DT 

IF(R .EC.l .AND.IR.NE.4)  GO  TO  900 
URITE(1*502) 

FORMAT!*  (4)  SYSTEM*, 

11X»* (ELEC, GSE,GUID,MECH, PROP, RF, SOP, MGS, EGStPERF)  », 

l,/,3(* ! *, 4X, * ! *) /) 

READ(1,503,ERR=501 )SYS 
F0RHAT(1X,3(A4,2X)) 

URITE(1,503)  SYS 

IF(R.EQ.1.AND.IR.NE.5)  GO  TO  2200 
URITE(1,902) 

FORMAT!*  (5)  VEHI CLE ♦ , /2 ( ♦ ! !*)/) 

READ(1,903,ERR  = 901) ( (VEH(I,J) ,J=1,2)  ,1  = 1,2) 
F0RMAT(2(1X,I3,A1,1X)) 

WRITE (1,903)  ((VEH(I,J),J=1,2),I=1,2) 

CONTINUE 


IF(R.EQ.1.AND.IR.NE.6)  GOTO  2300 
WRITE!! ,2202) 

FORMAT!*  (6)  SECTION*,/, 

15X,*E  SECT  . , UPPER  B , LOWER  B 

1,5X,*G  SECT  , UPPER  C , LOWER  C 

1,5X,*EG  SECT  , UPPER  0 , LOWER  0 

1,/,5X,*BASE  A , UPPER  F , LOWER  F 
1*CAST0R  IIA*,/,13X,*H/S  25/34  .H/S 
1*!*,12X,*  !*/) 
READ(1,2203,ERR=2201)SECT 


, ALCYONE  lA  , ALCYONE  IIA*,/ 
,ALGOLIIA  , ALGOL' IIIA*,/ 
,ANTARES  IIA  ,ANTARES  IIIA* 
,ALTAIR  IIIA  ,*, 

40/34  ,H/S  45/42*,/, 
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(21o5) 

2203 

F0RMAT(1X,3A4) 

(2136) 

URITE(lf2203)SECT 

(2137) 

2300 

IF(R.EQ.1.AND.IR.NE.7)  GOTO  2400 

(2158) 

IF(R.EQ.O)  GOTO  2301 

(2137) 

IF(NEWSHT.EO.l)  CALL  FIXSHT 

(2160) 

2301 

WRITE(1*2302) 

(2161 ) 

2302 

FORMAT(*  (7)  NUMBER  OF  SHEETS *,/•!»* 2X* •!»/ ) 

(2162) 

READ(1,2303.ERR=2301 )NSHT 

(2i6o) 

2303 

FORHAT( 1X,I2) 

(2164) 

. 

URITE(1*2303)NSHT 

(2165) 

IF(R.EQ.l.AND.NEWSHT.EQ.l)  CALL  SHTADD 

(2166) 

IF(R.EQ.O)  CALL  INPs's 

(2167) 

GO  TO  3800 

(216J) 

2400 

IF(R.EQ.1.AN0.IR.NE.8)  GO  TO  2500 

(2169: 

2407 

WRITE(lt2408) 

(2170: 

2408 

F0RHAT(*  UHAT  SHEET  NUMBER  IS  TO  BE  REVISED**/** 

(2111) 

1*  SHEET  # 2.1  !02 !! 10 !**/**  ! !!  !*/) 

(2172) 

FINISH=0 

(2173> 

READ(1,2409*ERR=2407)  ( I SHTN ( K ) * K=1 *2 ) 

(2174) 

2409 

F0RMAT(1X*I2.2X*I2) 

(21/3: 

IF(ISHTN(1).NE.1.0R.ISHTN(2).NE.O)  GOTO  2411 

(2176) 

2448 

WRITE(1*2402) 

(217?) 

READ(1,2403»ERR=2448)FREV 

(2)78) 

IF(IEOUP.EQ.O)  GOTO  3800 

(2179) 

IF(FNEO.NE.O)  FNEO=0 

(2160) 

DO  2449  K=l*10 

(2U1 ) 

FEOREF(K*l)=*  * 

(21£  2) 

FE0REF(K,2) =*  * 

(21£D 

2449 

CONTINUE 

(2164) 

60  TO  3800 

(21£5) 

2411 

CALL  SRCH$$(K$RDWR*K$NDAM* *STEHP  **6*10*1*10 

(218b) 

REWIND  12 

(21C7) 

2410 

READ( 12*END=2470)DRW*SHTN,REV*NE0*E0REF 

(2188) 

IF(FINISH.EQ.l)  GOTO  2460 

(2189) 

DO  2415  1=1*4 

(2190) 

IF(DRAW(I).NE.DRW(D)  GOTO  2460 

(2191) 

2415 

CONTINUE 

(2192) 

DO  2420  1=1,2 
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. <2:93)  IF<ISHTN(I).NE.SHTN(I))  GOTO  2460 

(219H)  2420  CONTINUE 

(2195)  2401  WR1TE(1»2402) 

(2196)  2402  FORHAT(»  SHEET  REVISION:  IF  NONEt  ENTER  NC »»/»•!•♦ 2 X» »»• /) 

<2157)  REA0<l»2403tERR=2448)REV 

<21935  2403  F0RMAT(1X*1A2) 

<2199)  WRITE(1,2403)REV 

(2200)  IF(IEOUP.EQ.O)  GOTO  2455 

<220  U IF(NEO.NE.O)'  NEO  = 0 

<220,2)  DO  2450  K = l»10 

(22113)  EOREF(K*l)  = * » 

(2204)  E0REF(Kf2)=»  ♦ . 

(2205)  2450  CONTINUE 

(2206)  2455  FINISH=1 

(2217)  2460  URITE(14)  DRU,SHTN»REV»NEO,EOREF 

(22)8)  GO  TO  2410 

(2239)  2470  CALL  SRCH S$ (K tCLOS ♦ »STEHP  »*6»0.0»0) 

(22.1.0)  CALL  SRCH$$(KSCLOS, ‘SHEET  NSfOtOfO) 

<22’.l)  CALL  SRCHS$(K$DELE» ‘SHEET  ‘*6t0,0,0) 

\<2212>  CALL  CN  AM  $S  ( ‘S  T EH=>’  ‘ , 6,  ‘ SHEET  *,6,IC) 

\<22’-j>  CALL  SRCHS$<KSRDU’R  + K$NOAM, ‘SHEET  ‘t6»8,l»IO 

<.22.'  4)  2500  IFCR.EO.l.AND.IR.NE.G)  GOTO  3800 

<22i5)  REWIND  12 

(2216)  2510  WRITE(li2511) 

(2217)  2511  FORKAT(‘  WHAT  SHEET  NUMBER  DO  YOU  WISH  TO  REVISE  A REFERENCED  ‘» 

(2210)  l‘E.D.‘,/,‘  example:  SHEET  #2.1  ! 02 ! ! 1 0 ! ‘ ‘ ! !!  J‘/> 

(2219)  REAC(1»2512»ERR=2510) (ISHTN(K) ,K=1,2) 

(222  0 5 2512  FORM AT ( IX , 12 , 2 X , I 2 ) 

(2221)  IF ( ISHTN ( 1 ) .NE .1 .OR. ISHTN(2) .NE.O ) GOTO  2515 

(2222)  DO  2550  1=1,10 

<22. :3)  IF(FE0REF(I,1).NE.‘  ‘)  GOTO  2553 

(2224)  GO  TO  2563 

(2225)  2553  URI TE < 1, 2505 ) I , < F EOREF < I , J) , J = 1 , 2 ) 

<222ti)'  2550  CONTINUE 

(22,:n  2563  WRITE(  1,2605) 

<22:;8>  REAO(  1 ,2620,ERR  = 2563)  lOPT 

(2229)  DO  2570  J=l,IOPT 

<22;i0)  IFdOPT.LT.O.OR.IOPT.GT.I)  GOTO  2563 
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(2231) 

(2232) 

2564 

(2233) 

(2234) 

2565 

(2255) 

(2236) 

2570 

(2251) 

(22.53> 

2515 

(2239) 

2516 

(2240) 
(2241  » 
(2242) 

2520 

(2245) 

(2244) 

(2245) 

2530 

(2246) 

(2247) 

(22'8) 

(2249) 

2503 

0 

1 

(2250) 

2505 

O 

(22.  1) 

2600 

(221.:!J 

2603 

(22‘.3) 

2605 

(2254) 

(2255) 

2620 

(22J6) 

(2257) 

(2256) 

(2259) 

2640 

(2260) 

2650 

(2261) 
(2262) 
(226  3) 
(2264) 

2660 

(2265) 

(2266) 

2670 

(2267) 

2700 

(2268) 

2750 

IFdOPT.EQ.O)  GO  TO  3800 
URITE(lt2650)  I 
READ(lt2620tERR=25&A)  K 
WRITE(1»2660) 

READ(1,2670.ERR=2565) (FE0REF(K,N),N=lt2) 

CONTINUE 
GO  TO  3800 

CALL  SRCH$$(KIRDUR+KINDAM»»STEMP  »»6tlO«lfIC) 

READ tl2»END=2800) DRW*SHTN,REV»NEO»EOREF 
DO  2520  1=1.4 

IF(DRAU'(I  ).NE.DRW(I)  ) GOTO  2750 

CONTINUE 

DO  2530  1=1.2 

IF(ISHTN(I).NE.SHTN(D)  GOTO  2750 
CONTINUE 
DO  2600  1=1.10 

IF(EOREF(I.l).NE.*  •)  GOTO  2503 
GO  TO  2603 

WRITE(1.2505)  I . ( EOREF ( I . J ) » J=l. 2 > ■ 

F0RHAT(3X.I2.».  ».2A4) 

CONTINUE 

URITE(1.2605) 

FORHAK*  HOW  MANY  DO  YOU  WISH  TO  REVISE*) 

READ ( 1.2620 .ERR=2603)IOPT 
FORKAT(I2) 

IF(IOPT.LT.O.OR.IOPT.GT.I)  GOTO  2603 
IF(IOPT.lQ.O)  GOTO  2700 
DO  2700  J=l.IOPT 
WRITEd  .2650)  I 

FORHATC*  ENTER  THE  REFERENCED  E.O.  NUMBER  TO  BE  REVISED*. 
1/.*  note;  must  BE  FROM  1 T0*.I2) 

READ(1.2620.ERR=2640)K 
WRITEd. 2660) 

FORMAT(*  ENTER  REVISED  REFERENCED  E.O. *./.*! *»8X» *! ♦/) 
READ(1.2670.ERR=2660) ( EOR EF ( K . N ) .N=l .2 ) 

F0RMAT(1X.2A4) 

CONTINUE 

WRITE<14)  DRW. SHTN. REV. NEO. EOREF 


/ US 
LSL-a 


) 
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(27S9)  C6  TO  2516 

(2270)  2000  CALL  SR CH $ J ( KSCLOS * *S TEMP  *i6»0,0,0) 

f2271)  CALL  SRCHSS(K$CLOS* ’SHEET  *»6*0»0«0) 

*22/2)  CALL  SRCHSKKSOELE. ’SHEET  ’♦6.0, 0,0) 

*22/3)  CALL  CNAMSK’STEH?  ’,6,’SHEET  ’,6,10 

*227'*)  CALL  SRCHS$(K$RDWR  + K$N0AM,’SHEET  ’,6,8,1,10 

(2275)  3000  CONTINUE 

(2276)  C 

(22//:>  C END  OF  INPUT/REVISE  ITEMS  AS  OF  7/26/78 

(2278)  C 

(2279)  9999  CALL  SHOUDU 

(2260  RETURN 

(2261)  END 
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O 


e 


CNAMSS 

R 

EXTERNAL 

000000 

2212 

2273 

DRAW 

J 

tl 

000000 

2060S 

2121M 

2123 

2190 

2241 

DRU 

J 

// 

000226 

2060S 

2187H 

2190 

2207 

2239H 

2241 

or 

I 

// 

C00130 

2060S 

2127H 

2129 

EOT 

I 

// 

C00A37 

2060S 

EON 

J 

// 

000312 

2060S 

EOREF 

J 

// 

000242 

20  60S 

2187H 

2203M 

2204H 

2207 

2239H 

2249 

2265H 

2268 

EOREV 

I 

// 

000436 

2060S 

EdVEH 

I 

// 

000445 

2060S 

DM  IT 

J 

// 

000370 

206CS 

EKDT 

I 

// 

000442 

206CS 

ETIT 

J 

// 

000316 

2060S 

FEOREF 

J 

// 

000156 

2060S 

2181H 

2182H 

2223 

2225 

2235H 

FINISH 

I 

003761 

2063S 

2172H 

2188 

22Q6H 

FIRST 

I 

// 

000465 

2060S 

FIXSHT 

R 

EXTERNAL 

000000 

2159 

FNEC 

I 

// 

000155 

2060S 

2179H 

FREV 

I 

// 

000154 

206CS 

2177H 

I 

I 

003762 

2115K 

2116 

2141K 

2143M 

2189M 

2190 

2193 

2222M 

2223 

2225 

2230 

2232 

2241 

2243H 

2244 

2246H 

2247 

2249 

2259 

IC 

I 

003764 

2185A 

2212A 

2213A 

2238A 

2273A 

2274A 

lOR 

J 

// 

000452 

2060S 

lEOUP 

I 

003765 

2063S 

2069H 

2101M 

2178 

2200 

lEr 

I 

000002 

2063S 

IKN7 

I 

003766 

2074K 

2076 

2077 

2078 

IKEO 

I 

// 

000462 

2060S 

IN;‘'SDU 

I 

000000 

2059S 

• 

INP'.S 

I 

EXTERNAL 

000000 

2166 

lOi’T 

I 

003767 

2063S 

2087M 

2088 

2089 

2097H 

• 2099 

222PK 

2229 

2230 

2231 

2254M 

■ 2256 

2258 

IR 

I 

003770 

2081 M 

2082 

2083 

2105 

2118 

2124 

2138 

2145 

2157 

2168 

2214 

ISHTN 

I 

000005 

2063S 

2173H 

2175 

2193  . 

2219H 

2221 

J 

I 

003771 

2141H 

2143H 

2225H 

2229H 

2249H 

2258H 
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2268 


22A7 


2192H 

22A0M 

2256 


2100 

2257 

2130 


22AA 
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K 

I 

003772 

2173H 

2180K 

2181 

2182 

2219K 

2233H 

2235 

2262M 

KJ ALLD 

I 

PARAMETER 

2061S 

rSCACC 

I 

PARAMETER 

2C61S 

rSCLOS 

I 

PARAMETER 

2061S 

2209 

2210 

2270 

KICONV 

I 

PARAMETER 

2061S 

r;$CURR 

1 

PARAMETER 

2061S 

kjde:le 

I 

PARAMETER 

2061S 

2211 

2272 

KSDMPB 

I 

PARAMETER 

2061S 

KSDTIM 

I 

PARAMETER 

2061S 

KIF.NTR 

I 

000000 

2061S 

>'.SEXST 

1 

PARAMETER 

2061S 

KSGONO 

I 

PARAMETER 

2061S 

KSGPOS 

I 

PARAMETER 

2061S 

SHOKE 

I 

PARAMETER 

2061S 

KSICUR 

I 

PARAMETER 

2061S 

XSIMFO 

I 

PARAMETER 

2C61S 

KSIRTN 

I 

PARAMETER 

2C61S 

KSISEG 

I 

PARAMETER 

2061S 

KSIUFO 

I 

PARAMETER 

2061S 

XSKENT 

I 

000000 

2061S 

i<SHSIZ 

I 

PARAMETER 

2061S 

KSMVNT 

1 

PARAMETER 

2061S 

XSNDAH 

I 

PARAMETER 

2061S 

2185 

2213 

2238 

KSNRTN 

I 

PARAMETER 

2061S 

KSNSAM 

r 

PARAMETER 

2061S 

XSNSGD 

I 

PARAMETER 

2061S 

K5NSGS 

I 

PARAMETER 

2061S 

KIPOSA 

I 

PARAMETER 

2061S 

XSPCSN 

I 

PARAMETER 

20eiS 

KSPOSR 

I 

PARAMETER 

2061S 

XSPSEA 

I 

PARAMETER 

2061S 

XSPRER 

I 

PARAMETER 

2061  S 

KiPROT 

I 

PARAMETER 

2061S 

k;rdwr 

I 

PARAMETER 

2061S 

2185 

2213 

2238 

KtREAD 

I 

PARAMETER 

2061S 

KiRPOS 

I 

° ARAMETER 

2061S 

KSRSUB 

I 

PARAMETER 

2061S 
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2202H  2203  2204 

2265 

2271 


2274 


2274 
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KSRULK 

I 

PARAMETER 

2061S 

K»SENT 

I 

000000 

2061S 

K ;SETC 

I 

parameter 

2061S 

KISETH 

I 

PARAMETER 

2061S 

KISPOS 

I 

PARAMETER 

2061S 

k:srtn 

I 

PARAMETER 

2061S 

KiTRNC 

I 

PARAMETER 

2Q6IS 

KJUPOS 

I 

PARAMETER 

2C61S 

KOHRIT 

I 

PARAMETER 

2C61S 

kp:t 

0 

// 

000463 

2060S 

l:;n 

I 

003774 

2109M 

2110A 

LOOP 

I 

003775 

2078M 

N. 

1 

003776 

2235H 

2265H 

NEU 

I 

// 

000241 

2060S 

2187H 

2201H 

2207 

NEUSHT 

I 

003777 

2063S 

2070M 

2090M 

2159 

NSHT 

I 

// 

000153 

206CS 

2162M 

2164 

PTIT 

J 

// 

000062 

20SOS 

2113 

2116 

R 

I 

// 

000451 

206CS 

2071 

2105 

2118 

2145 

2157 

2158 

2165 

REV 

I 

// 

000240 

2060S 

2187M 

2197M 

2199 

SECOND 

I 

// 

000466 

2060S 

SECT 

J 

If 

000145 

2060S 

2154H 

2156 

SH0'.;DW 

R 

EXTERNAL 

OOOOOO 

2279 

ShTADD 

R 

EXTERNAL 

000000 

2165 

ShlN 

I 

ft 

000236 

2C60S 

2187H 

•2193 

2207 

SRCHSJ 

R 

EXTERNAL 

000000 

2185 

2209 

2210 

2211 

2271 

2272 

2274 

S^S 

J 

ft 

000133 

2060S 

2135M 

2137 

TINPUT 

R 

EXTERNAL 

000000 

2110 

TIT 

J 

// 

000010 

2060S 

2110A 

2111 

TTIT 

J 

ft 

000467 

2060S 

2116H 

VEH 

I 

ft 

000141 

2060S 

2141M 

2143 

1 

000025 

2072 

20730 

10 

000072 

2074 

20750 

2081 

100 

000524 

2071 

2082 

2088 

2091 

101 

000543 

2106 

21070 

_1C2 

000623 

2111 

21120 

) 
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2239M 

2268 

2165 

2124 

2130 

2138 

2166 

2168 

2214 

2207 

2239M 

2268 

2239M  22A4  2268 

2213  2238  2270 


2099  21050 


) 
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0 

1 

CJl 

cn 


_1QJ 

000537 

21060 

10<» 

000664 

2115 

21170 

105 

000643 

,2113 

21140 

-11 

000207 

2084 

20850 

-110 

000575 

21080 

-'•9 

000325 

2083 

20920 

2097 

2100 

j 

000020 

20720 

2074 

2076 

2077 

-2C 

000331 

2092 

20930 

ano 

000673 

2105 

21180 

.COl 

000707 

21190 

2121 

ac2 

000713 

2119 

21200 

_Cfi3 

000750 

2121 

21220 

2123 

.2200 

001345 

213B 

21440 

.2201 

001362 

21460 

2154 

.2202 

001366 

2146 

21470 

'2203 

001656 

2154 

. 21550 

2156 

.2300 

001672 

2145 

21570 

.2301 

001716 

2156 

21600 

2162 

.2302 

001722 

2160 

21610 

2303 

001757 

2162 

21630 

2164 

.2400 

002012 

2157 

21680 

.2401 

002355 

21950 

2402 

002362 

2176 

2195 

21960 

2403 

002426 

2177 

2197 

21980 

2199 

2407 

002026 

21690 

2173 

24C8 

002032 

2169 

21700 

24C9 

002143 

2173 

21740 

2410 

002256 

21870 

2203 

2411 

002243 

2175 

21850 

2415 

002327 

2189 

21910 

2420 

002347 

2192 

21940 

2448 

002167 

21760 

2177 

2197 

2449 

002234 

2180 

21830 

2450 

002467 

2202 

22050 

2455 

002475 

2200 

22060 

24a0 

002500 

2183 

2190 

2193 

22070 

2470 

002524 

2187 

22090 

25 

000505 

2087 

2097 

20980 
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_:^500 

002573 

2168 

22140 

2503 

003310 

2247 

22490 

2505 

003342 

2225 

2249 

22500 

..2  510 

002613 

2216D 

2219 

_2'jll 

002617 

2216 

22170 

25J2 

002741 

2219 

22200 

2015 

003165 

2221 

22380 

_.':516 

003175 

2239D 

2269 

_252C 

003244 

2240 

22420 

_2530 

003264 

2243 

22450 

2550 

003040 

2222 

22260 

2553 

003004 

2223 

22250 

_25(i3 

003046 

2224 

22270 

2228 

2230 

2564 

003103 

2232D 

2233 

..2565 

003123 

2234D 

2235 

_2570 

003157 

2229 

22360 

.,;;eoo 

003354 

2246 

22510 

. 2603 

003363 

2248 

22520 

2254 

2256 

_2605 

003367 

2227 

2252 

22530 

_?b20 

003424 

2228 

2233 

2254 

22550 

..1640 

003450 

2259D 

2262 

_2650 

003457 

2232 

2259 

22600 

_2  66  0 

003547 

2234 

2263 

22640 

2265 

~2670 

003632 

2235 

2265 

22660 

2 70  0 

003637 

2257 

2258 

22670 

_2750 

003646 

2241 

2244 

22680 

2800 

003672 

2239 

22700 

_3 

0CO114 

2079 

20800 

_3800 

003741 

2078 

2167 

2178 

2184 

' 2275D 

_400 

000766 

2118 

21240 

_4  01 

001001 

21250 

2127 

402 

001005 

2125 

21260 

403 

001041 

2127 

21280 

2129 

_5 

000110 

20790 

2081 

_5C0 

001055 

2124 

21300 

looi 

001070 

21310 

2135 

_502 

001075 

2131 

21320 

2262 


221.4 


2231 
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_503 

001161 

2135 

21360 

2137 

5 

000203 

20840 

2087 

2089 

_900 

001200 

2130 

21380 

901 

001214 

2139D 

2141 

902 

001220 

2139 

21400 

_903 

001301 

2141 

21420 

2143 

J999 

003751 

22790 
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O 


,C» 


(2r82> 

(2283) 

(22E3) 

(2283> 

<2283) 

(22e3> 

(22C3) 

(2283? 

(2283J 

(2283? 

(2283} 

{2283? 

(2233) 

(2283) 

(22f;3> 

(2283) 

(2283) 

(22(13) 

(22G3) 

(22£4) 

(2285) 

(2286) 

(2287) 

(2268) 

(2289) 

(2290) 

(2291) 

(2292) 

(2293) 

(2299) 

(2295) 

(2296) 

(2297) 

(2298) 

(2295) 

(2300) 

(2301) 

(2302) 


SUBROUTINE  INPSS 
C 

C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 
C 

COMMON  ORAU,TIT.PTITtDT»SYS»VEH,SECT»NSHTfFREVtFNEO»FEOREF» 

1 DRW,SHTN,REV,NEO,EOREF» 

1 EON»ETIT»EPTIT,EOREV,EDT,ERDT»EOVEHt 

1 R, IDRtINEOtKNT, FIRST, SECONDtTTIT 

C 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

C 

INTEGER‘9 

1 
1 

INTEGER*2 

1 
1 
C 
C 

1000  WRITEdtlOOl)  ' 

1001  FORMAT!*  ENTER  THE  FOLLOWING  DATA:*,/,*  SHEET#  1*,/,*  REVISION*, 

1*:  IF  NONE,  NC*,/,*»  !*/) 

READ(1,1003,ERR=1000)FREV 
1003  F0RMAT(1X,A?) 

1005  URITE(1,1006) 

1006  FORMAT!*  NUMBER  OF  E . 0. * * S • , / , * ! !*/) 

READ(1,1008,ERR=1D05)FNEO 

1008  FORMAT! IX, 12) 

DO  1009  1=1,10 
DO  1010  J=l,2 
FE0REF(I,J)=*  * 

1010  CONTINUE 

1009  CONTINUE  . ' 

IF(FNEO.EQ.O)  GOTO  1200 

URITE(1,25D2) 

DO  1200  K=l,FNEO 

1201  URITE(1,2510)  . 

READ (1, 2520, ERR  = 1201 ) (FEOREF(K,L) ,L  = 1,2) 


DRAU(9),T1T{21),PTIT(19),SYS(3),SECT(3),FEOREF(10,2), 

DRU(9),E0REF(10,2),EPTIT(19),ETIT(21),E0N(2), 

IDR(9),KNT,TTIT(19) 

DT(3) ,VEH(2,2) ,NSHT,SHTN(2) ,FREV,FNEO,REV,NEO, 
F0REV,ED7(3) ,ER0T(3) ,E0VEH(2,2) ,R,INEO, 

FIRST, SECOND 
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(2J03)  REUIND  18 

(22>1A)  1203  REAO(18,ENO=1210)EONtETIT,EPTIT,EOREV,EDT,EROT.EOVEH 

(2in'5>  00  1206  L = l»2 

12316)  IF<E0N(L) .NE.FEOREF(K»L) ) GOTO  1203 

(23H7)  1206  CONTINUE 

(2308)  GO  TO  1200 

(2309)  1210  R=0 

(231C)  FIRST=1 

(2311)  URITE(lfl205) 

(2312)  1205  FORHATt»  ENTER  ANY  FURTHER  AVAILABLE  DATA  FOR  EACH  E.O.*/) 

(2313)  1211  READ(18tEND=1215)E0NtETIT»EPTITtE0REV»EDT»ERDT»E0VEH 

(2314)  GO  TO  1211 

(2315)  1215  CALL  INPSE 

(2336)  DO  1216  H=l,2 

(2337)  E0N(H)rFE0REF (K »M) 

(2318)  1216  CONTINUE 

*2319)  WRITE(18)E0N»ETIT»EPTIT  » EOREV » ED T »ERDT tEOVEH 

(2320)  1200  CONTINUE 

(2321)  IF(NSHT.LT.2)  RETURN 

in  (2322)  2400  DO  2800  J = 2,NSHT 

« (2323)  2401  URITE(1»2402) 

vti  (2324)  2402  F0RHAT(»  ENTER  THE  FOLLOWING  D AT A I • » / * 2X» • EX AMPLE  SHEET  ENTRY:*# 

(2325)  1*SHEET#2.1  !02!!10!*»/#»!  !!  !•/) 

*2326)  READd  #24 03 #ERR  = 24 0 1 ) (SHTN(K)#K  = 1#2) 

(2327)  2403  FORMA T ( Ix , 1 2 # 2 X# I 2 ) 

(2328)  2404  WR I T E ( 1 #24 05 ) 

(2329)  2405  FORMAT!*  REVISION:  IF  NONE#  NC*#/#*!  !•/) 

(2330)  READ(1#1003*ERR=2404)REV 

(2331)  2406  WRITEd  #1006) 

(2332)  READd,  1008, ERR=2406)NEO 

(2333)  DO  2451  K=l,10 

(2334)  DO  2450  L=l,2 

(2335)  EOREF(K#L)=*  * • ' 

(2336)  2450  CONTINUE 

(2337)  2451  CONTINUE 

(2333)  IF(NEO.EQ.O)  GOTO  2700 

(2339)  IF(NEO.LT.O)  GOTO  2401 

(2340)  2500  WRITE(1#2502) 
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(23')l)  2502  FOftHAK*  (9)  REFERENCED  E.O.»»S») 

(2392J  DO  2550  K=l»NEO 

(23“3i  2508  URITE(lt2510) 

(23^^)  2510  FORHATC •! »,8X»  • !♦) 

C23«i5)  REAO(lt2520fERR=2508)  ( EOREF  ( K , L ) f L = 1 »2 ) 

(23'>6)  2520  F0RHAT<1X*2AA) 

<23-*7)  WRITE(ltl205) 

(25A8)  REWIND  18 

(2349)  2530  R E AD ( 1 8 ,END=124 0) EON , ETI T , EPT I T t EOREV»EDT,ERDT»EOVEH 

<2550)  . DO  2532  L=l,2 

(2351)  IF(EON(L) .NE.EOREF(KtL) ) GOTO  2530 

(2552)  2532  CONTINUE 

(2353)  GO  TO  2550 

(27.54)  1240  R = 0 

(2355)  FIRST=1 

(2756)  2522  RE AD ( 1 8, END=2545 ) EON ,ETI T »EPT I T ,EORE V,EDT t ERDT* EO VEH 

(2357>  GO  TO  2522 

(2358)  2545  CALL  INPSE 

(2359)  DO  2546  H = 1 ,2 

O (2360)  EON(K)=EOREF(KtH) 

■ • (2361)  2546  CONTINUE 

(2362)  WRITE(18)E0N,ETIT,EPTITfE0REVtEDT,ERDT»E0VEH 

(2363)  2550  CONTINUE 

(2364)  2700  URITE(12)DRAUiSHTN, REV, NEO, EOREF 

(2365)  2800  CONTINUE 

(2366)  RETURN 

(2367)  END 
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O^AU 

J 

// 

oooooo 

2283S 

2364 

CKU 

J 

// 

000226 

2283S 

cr 

I 

// 

000130 

22  83S 

EL-T 

I 

// 

000437 

2283S 

2304K 

2313H 

2319 

2349M 

2356M 

2362 

EOM 

J 

// 

000312 

2283S 

2304K 

2306 

2313H 

2317M 

2319 

2349M 

2351 

2356M 

236GH 

2362 

EOP.EF 

J 

// 

000242 

2283S 

2335H 

2345H 

2351 

2360 

2364 

EC  REV 

I 

// 

000436 

2233S 

2304H 

2313M 

2319 

2349H 

2356H 

2362 

EOVEH 

I 

// 

000445 

2283S 

2304H 

2313M 

2319 

2349H 

2356H 

2362 

EPTIT 

J 

// 

000370 

2283S 

2304K 

2313H 

2319 

2349K 

2356H 

2362 

ER  DT 

I 

// 

000442 

2283S 

230  4H 

2313H 

2319 

2349H 

2356M 

2362 

ET  IT 

J 

// 

000316 

2283S 

2304H 

2313M 

2319 

2349M 

2356M 

2362 

FEOREF 

J 

// 

000156 

2283S 

2255M 

2302M 

2306 

2317 

FIRST 

I 

// 

000465 

2233S 

2310H 

2255H 

FNEO 

I 

// 

000155 

2283S 

2291H 

2298 

230  0 

FPEV 

I 

// 

000154 

2283S 

2287H 

I 

I 

001371 

2293H 

2295 

lOR 

J 

// 

000452 

2283S 

INEO 

I 

// 

000462 

2283S 

INPSE 

I 

EXTERNAL 

oooooo 

2315 

2358 

INPSS 

I 

oooooo 

2282S 

J 

I 

001373 

2294H 

2295 

2322H 

K 

I 

001374 

2300H 

2302 

2306 

2317 

2326M 

2333H 

2335 

2342P 

2345 

2351 

2360 

KMT 

J 

// 

000463 

2283S 

L . 

I 

001375 

2302H 

2305H 

2306 

2334M 

2335 

2345M 

2350H 

2351 

. ^ 

« 

I 

001376 

2316M 

2317 

2359M 

2360 

NEO 

I 

// 

000241 

2283S 

2332M 

2338 

2339 

2342 

2364 

NSHT 

I 

// 

000153 

2283S 

2321 

2322 

• 

niT 

J 

// 

000062 

2283S 

R 

I 

// 

000451 

2283S 

2309H 

2354H 

REV 

I 

// 

000240 

2283S 

2330H 

2364 

, 

SECOND 

I 

// 

000466 

2283S 

SECT 

J 

// 

000145 

2283S 

SHTN 

I 

// 

000236 

2283S 

2326M 

2364 

SYS 

J 

// 

000133 

22833 

. 

TIT 

J 

// 

000010 

2283S 
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TTIT  J // 

000467 

2283S 

VEU  I // 

000141 

2283S 

_1000 

000001 

2284D 

2287 

ICOl 

000006 

2284 

22850 

Il003 

000073 

2287 

22880 

2330 

„1005 

000100 

2289D 

2291 

“l00  6 

000104 

2289 

22900 

2331 

“iCioe 

000136 

2291 

22920 

2332 

_lCiC9 

000174 

2293 

22970 

_1010 

000165 

2294 

22960 

_12G0 

000522 

2298 

2300 

2308 

_1201 

000215 

23010 

• 2302 

_12C3 

000255 

23040 

2306 

_X205 

000355 

2311 

23120 

2347 

1206 

000335 

2305 

23070 

_i210 

000343 

2304 

23090 

~1211 

000410 

23130 

2314 

1215 

000443 

2313 

23150 

_1216 

000464 

2316 

23180 

_12A0 

001202 

234? 

23540 

_2A00 

000537 

23220 

12401 

000542 

23230 

2326 

2339 

_2402 

000547 

2323 

23240 

*2403 

000657 

2326 

23270 

~2404 

000667 

23280 

2330 

“'2405 

000573 

2328 

23290 

_2406 

000730 

23310 

2332 

_2450 

000766 

2334 

23360 

2451 

000774 

2333 

23370 

_2500 

001010 

23400 

_2502 

001014 

2299 

2340 

23410 

~2508 

001035 

23430 

2345 

2510 

001041 

2301 

2343 

23440 

2520 

001100 

2302 

2345 

23460 

2522 

001210 

23560 

2357 

_2  530 

001114 

23490 

2351 

_2532 

001174 

2350 

23520 

23200 
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0012'i3  2356  2358D 

001265  2359  23610 

001324  2342  2353  23630 

001332  2338  23640 

001355  ' 2322  23650 
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:>545 

2546 

2550 

12700 

2800 
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(236Ri 
(2369) 
(2369J 
(2369) 
(2369) 
(2369) 
(2369) 
(2369) 
(2369) 
(2365) 
(2369) 
(2369) 
(2369) 
(2369) 
(2369) 
(2369) 
(2369? 
(2369) 
(2369) 
(2370) 
(2370) 
(2371) 
(2372) 
(23?3) 
(2374) 
(2375) 
,(2376) 
(2377) 
(2378) 
(2379) 
(2380) 
(2381  ) 
(2382) 
(2383) 
(238'*) 
(2385) 
(2386) 
(2387) 


SUBROUTINE  FIXSHT 
C 

C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

C 

COMMON  DRAU,TIT,PTIT,DT,SYS»VEH,SECT»NSHT»FREV,FNEO»FEOREF* 

1 DRJ»SHTNtREV,NEO»EOREF» 

1 EON,ETIT,EPTITtEOREVtEDT,ERDT,EOVEH* 

1 R»IDR»INEO,KNT»FIRSTfSECOND*TTIT 

C 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO:  FILE 

C 

INTEGER*^ 

1 
1 

INTEGER«2 

1 

1 ■ 

C 
C 

C SYSCOH>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  3L  MAY»  1977 

NOLIST 
REWIND  12 

CALL  SRCH$S(K$ROUR*K$NDAHf »STEHP  •♦G»10,ltIC> 

50  • READ(12*END=1000)  DRW ♦ SHTN tRE V tNEO * EOREF 

DO  100  1 = 1, A 

IF(DRAU(I  ) .NE.DRUd  ) ) GOTO  200  ■ 

100  CONTINUE 
RETURN 

200  URITE(1A)DRW,SHTN,REV,NE0, EOREF 
GO  TO  50  . 

1000  URITE(1,300) 

300  FORMATC  AN  ERROR  HAS  OCCURRED  DURING  THIS  OPERATION*) 

CALL  SRCH$$(KICLOS, ‘STEMP  *,6,0, 0,0) 

CALL  SRCHtKKSCLOS,  *DRAU  *,6,0, 0,0) 

CALL  SRCH$$ (KSCLOS, *EO  *,6,0, 0,0) 

CALL  SRCH$$ (KSCLOS, *SHEET  *,6, 0,0,0)  . . 

CALL  SRCH$$(K$CLOS,*REVS  *,6,0, 0,0) 


) 


DRAW (A) ,TTT(21) ,PTIT(19) ,SYS(3),SECT(3) ,FEOREF(10,2)  , 
DRU(A),EOREF(10,2) ,EPTIT(19) ,ETIT(21) ,E0N(2), 
ICR(A),KNT,TTIT(19) 

DT(3) ,VEH(2,2) ,NSHT,SHTN(2) ,FREV,FNEO,REV,NEO, 
E0REV,E0T(3) ,ERDT(3)  ,E0VEH(2,2) ,R,INEO, 

FIRST, SECOND 


3 
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(2388)  dALL  EXIT 

(2389)  END 


o 

CT> 

CJl 
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ORAU 

J 

n 

000000 

2369S 

OR'x' 

J 

// 

000226 

2369S 

DT 

I 

// 

000130 

2369S 

EOT 

I 

// 

000A37 

2369S 

EON 

J 

// 

0 0 0'312 

2369S 

EOREF 

J 

// 

000242 

236PS 

EOREV 

I 

// 

000436 

2369S 

EOVEH 

I 

// 

000445 

2369S 

EP  riT 

J 

7/ 

000370 

2365S 

ERDT  . 

I 

// 

000442 

2369S 

ETK 

J 

// 

000316 

2369S 

EXIT 

R 

EXTERNAL 

000 000 

23G3 

FLOREF 

J 

// 

000156 

2369S 

FIRST 

I 

// 

000465 

2369S 

FIXSHT 

R 

000000 

2368S 

FNEO 

I 

// 

000155 

2369S 

FREV 

I 

// 

000154 

2369S 

I 

I 

000227 

237f.H 

IC 

I 

000231 

2372A 

I DR 

J 

// 

000452 

2365S 

If.EO 

I 

// 

000462 

2369S 

KIALLD 

I 

PARAMETER 

2370S 

KSCACC 

I 

PARAMETER 

2370S 

KiCLOS 

I 

PARAMETER 

2370S 

KiCONV 

I 

PARAMETER 

237CS 

KSCURR 

I 

PARAMETER 

237CS 

KSDELE 

I 

PARAMETER 

2370S 

XJDMPB 

I 

PARAMETER 

2370S 

KIDTIM 

I 

PARAMETER 

\ 

237GS 

XiENTR 

I 

000000 

237CS 

KSEXST 

I 

PARAMETER 

237CS 

KSOOND 

I 

PARAMETER 

2370S 

KIGPOS 

I 

PARAMETER 

237CS 

KSHOME 

I 

PARAMETER 

2370S 

KSICUR 

I 

PARAMETER 

2370S 

Ktifir  0 

I 

PARAMETER 

2370S 

KlIRTN 

I 

PARAMETER 

2370S 

K JISEG 

I 

PARAMETER 

2370S 

2376 

237^H 


2374M 


2376 


2383 


2376 


2379 


238't 


2379 


2385 


2386 


2387 
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K1 lUFD 

I 

parameter 

2370S 

KJNENT 

I 

000000 

237GS 

Ksrsiz 

I 

PARAMETER 

2370S 

KIHVNT 

I 

PARAMETER 

2370S 

KSNOAH 

I 

PARAMETER 

2370S 

2372 

KSNRTN 

I 

PARAMETER 

2370S 

KSNSAH 

I 

PARAMETER 

237CS 

KSNSGD 

I 

PARAMETER 

2370S 

K!.NSGS 

I 

PARAMETER 

2370S 

KiPOSA 

I 

PARAMETER 

2370E 

KiFOSN 

I 

PARAMETER 

237CS 

KJPoSR 

I 

PARAMETER 

2370S 

KiPREA 

I 

PARAMETER 

237CS 

KiPRER 

I 

PARAMETER 

2370S 

K4PP0T 

I 

PARAMETER 

2370S 

KSRDUR 

I 

PARAMETER 

2370S 

2372 

KiREAD 

I 

PARAMETER 

2370S 

KSRPOS 

I 

PARAMETER 

23  7 OS 

K SR SUB 

I 

PARAMETER 

2370S 

KSftWLK 

I 

PARAMETER 

237CS 

KSSENT 

I 

000000 

2370S 

NJ 

KSSETC 

I 

PARAMETER 

237CS 

KSSETH 

I 

PARAMETER 

2370S 

ASSPOS 

.1 

PARAMETER 

23  70S 

K5.SRTN 

I 

PARAMETER 

237CS 

KSTRNC 

I 

PARAMETER 

2370S 

Kf.UPCS 

I 

PARAMETER 

2370S 

KSWRIT 

I 

PARAMETER 

2370S 

K M' 

J 

//  000A63 

2369S 

NEC 

I 

//  0002A1 

2363S 

2374M 

2379 

NSHT 

I 

//  000153 

2369S 

PI  IT 

J 

//  000062 

2369S 

R 

I 

H 000451 

2369S 

REV 

I 

//  000240 

2369S 

2374M 

2379 

SECOND 

I 

//  000466 

2365S 

SECT 

J 

//  000145 

2369S 

SHTN 

I 

H 000236 

2369S 

2374M 

2379 

SRCHJS 

R 

EXTERNAL  000000 

2372 

2383 

2384 

L 
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SV3 

J 

// 

000133 

2369S 

VXT 

J 

// 

000010 

2369S 

TTU 

J 

// 

000467 

2369S 

VEH 

I 

// 

000141 

2369S 

_ICC 

000063 

2375 

23770 

_1C00 

000117 

2374 

23810 

I2OO 

000073 

2376 

23790 

30C 

000124 

2381 

23820 

~50 

000014 

23740 

2380 
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(2390) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391) 
(2391 ) 
(2391; 
(23915 
(2391) 
(2391) 
(2391) 
(2391  ) 
(2391) 
(2391) 
(2392) 
(2392) 
(2393) 
(2599) 
(23'^3) 
(2356) 
(2397) 
(235S) 
(2399) 
(24CC) 
(2'tOl) 
(29C2) 
(2403) 
(2404  ) 
(2405) 
(2406) 
(2407) 
(240D) 
(24095 
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SUBROUTINE  SHTADD 
C 

C COMMON  BLOCK  FOR  THE  DRAU-EO  FILE 

C 

COMMON  ORAU,TIT,PTITtDT,SYS,VEH*SECT»NSHTtFREV,FNEO»FEOREF» 

1 DRW»SHTN,REV*NEOtEOREF« 

1 EONiETIT,EPTIT,EOREV,EDT,ERDT,EOVEH, 

1 Rt I DR. INFO »KNT, FIRST, SECOND *TTIT 

c ■ 

C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

DRAU(4)  ,TIT(21 ) ,PTIT(  19) ,SYS(3),SECT(3) ,FEOREF(10,2) ♦ 
DRU(4),EOREF(10,2),EPTIT(19),ETIT(21),EON(2), 
IDR(4),KNT,TTIT(19) 

DI  (3) ,VEK(2,2) ,NSHT,SHTN(2) .FREV.FNEO.REV.NEO, 
EOREV.EDTC  3) .EROT(3).EOVEH(2,2),R,INEO. 

FIRST, SECOND 


MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN).  31  HAY,  1977 

IIREV,IISHTN(2) ,IINEO,FINISH 
IIEORE(10,2) 

5 URITEd.lO) 

10  FORHAK’  ENTER  SHEET  NUMBER:  EXAMPLE  SHEET82.1  !02!!10!*,/, 

!•!  ! ! ! •/) 

READ(1,15,ERR  = 5)(IISHTN(N)  ,N  = 1,2) 

15  F0RHAT(1X,I2,2X,I2) 

IF ( 1 1 SHTN ( 1 ) .EO.l ) GOTO  30 

16  IF( IISHTN(  1)  .EG  .SHTN(l)  ) GOTO  105 
DO  20  1=1  ,4 

IF(DRW(  I) ,NE.DRAW( I ) ) GOTO  30 
20  CONTINUE 

GO  TO  105 
30  IIREV=*NC* 

IINEO=0 

URITE(14) DRU.IISHTN, IIREV.IINEO.IIEORE 


C 

INTEGER*4 

1 

1 

1NTEGER*2 

1 

1 

C 

C 

C SYSCOH>KEYS.F 
NOLIST 
INTEGER*2 
INTEGER*4 
FINISH=0 
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(2'ilO)  URITEdAJDRWf  SHTN,REV»NEO«EOREF 

FINISH  = 1 

(2'yl2)  100  READ(12*END  = 200)ORU’fSHTNtREV,NEOtEOREF 

(24lJ>  IF(FINISH.EQ.O)  GOTO  16 

(2H1AJ  105  URITE(1A)DRU,SHTN,REV*NEO,EOREF 

(2A15>  GO  TO  100 

(2<ii6>  200  CALL  SR  CH  J$  ( KtCLOS , ’SHEET  ’,6*0»0»0) 

<2'tlT>  CALL  SRCHIJ  (KICLOS* ’STEHP  »»C«0*0»0) 

<2'tie>  CALL  ShCrtS$(KJnELE»’SHrET  ’,6f0f0»0) 

(2'tl9>  CALL  CNAMtS  ( ’STEH3  ».6i’SHEET  *»6tIC) 

<2A20)  call  SRCHJS (KIRDUR+KINDAH, ’SHEET  ’fbtStltlC) 

(2A21)  RETURN 

(2422)  END 


Ul-Q 
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CNAHSS 

R 

external 

000000 

2419 

DRAW 

J 

// 

OOOCOO 

2391S 

2404 

DRW 

J 

// 

000226 

2391S 

2404 

2409 

2410 

2412M  2414 

DT 

I 

// 

000130 

2391S 

£DT 

I 

// 

000437 

2391S 

EON 

J 

// 

000312 

2391  S 

EOREF 

J 

// 

000242 

2391S 

2410 

2412M 

2414 

EDREV 

I 

// 

000436 

2391S 

EOVEH 

I 

// 

000445 

2391S 

EFTir 

J 

// 

000370 

2391S 

ERDT 

I 

// 

000442 

2391S 

ETIT 

J 

// 

000316 

2391S 

FEOREF 

J 

// 

0C0156 

2391S 

FINISH 

I 

000434 

2393S 

2395M 

2411H 

2413 

* 

r I RST 

I 

// 

000465 

2391S 

FNf.C 

I 

// 

000155 

2351S 

FREV 

I 

// 

000154 

2391S 

T 

I 

000435 

2403H 

2404 

IC 

I 

000437 

2419A 

2420A 

I DR 

J 

// 

000452 

2391  S 

II  lore 

J 

000002 

2394S 

2409 

1 1 NED 

I 

000440 

2393S 

2408M 

2409 

n REV 

I 

000441 

2393S 

2407M 

2409 

IISHTN 

I 

u 

000052 

2393S 

2399H 

2401 

2402 

2409 

INEO 

I 

000462 

2391S 

KSALLD 

I 

PARAMETER 

2392S 

KICACC 

I 

PARAMETER 

2392S 

KiCLOS 

I 

PARAMETER 

2392S 

2416 

2417 

KSCONV 

I 

PARAMETER 

2392S 

KSCURR 

I 

PARAMETER 

2392S 

KSCELE 

I 

PARAMETER 

2392S 

2418 

KJ0MP3 

I 

PARAMETER 

2392S 

K5DTIK 

I 

PARAMETER 

2392S 

KSENTR 

I 

000000 

2392S 

KIEXST 

I 

PARAMETER 

2392S 

KSGONO 

I 

PARAMETER 

2392S 

KIGPOS 

I 

PARAMETER 

2 3 9 2 S 

KJHOME 

I 

PARAMETER 

2392S 
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e 


KSIC'JR 

1 

PARAMETER 

2392S 

KSIMFD 

I 

PARAMETER 

2392S 

KSIRTN 

I 

PARAMETER 

2392S 

KtlSEG 

I 

PARAMETER 

2392S 

KSIUfD 

I 

PARAMETER 

2392S 

KSHENT 

I 

000000 

2392S 

KtMSIZ 

I 

PARAMETER 

2392S 

KJKVNT 

I 

PARAMETER 

239  2 S 

KSNDAH 

I 

PARAMETER 

2392S 

2420 

KSNRTN. 

I 

PARAMETER 

2392S 

KI.NSAM 

I 

PARAMETER 

2392S 

KSNSGD 

I 

PARAMETER 

2392S 

KiMSGS 

I 

PARAMETER 

2392S 

KiPOSA 

I 

PARAMETER 

2392S 

r<  3 P 0 S N 

I 

PARAMETER 

2392S 

KSPCSR 

1 

PARAMETER 

2392S 

KSPPEA 

I 

PARAMETER 

2392S 

KS.PRER 

I 

PARAMETER 

2392S 

KSPSOT 

I 

PARAMETER 

2392S 

KiSDUR 

I 

PARAMETER 

2392S 

2420 

KSREAD 

I 

PARAMETER 

2392S 

KSRPOS 

I 

PARAMETER 

2392S 

K3RSUB 

I 

PARAMETER 

2392S 

KSRCLK 

I 

PARAMETER 

2352S 

KSSENT 

I 

000000 

2392S 

KSSETC 

I 

PARAMETER 

■ 2392S 

KSSETH 

I 

PARAMETER 

2392S 

KSSPOS 

I 

PARAMETER 

2392S 

KSSRTN 

I 

P ARAMETER 

2392S 

ksTRNC 

I 

PARAMETER 

2392S 

KiUPOS 

I 

PARAMETER 

2392S 

KSWRIT 

I 

PARAMETER 

2392S 

K.NT 

J 

//  000463 

2391S 

N : 

I 

000442 

2399M 

NEO 

I 

//  000241 

2391S 

2410 

NSHT 

I 

//  0001B3 

2391S 

PTIT 

J 

//  000062 

2391S 

R 

I 

//  000451 

2391S 

2412H  2A14 
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REV 

I 

// 

000240 

2391S 

2410 

2412M 

2414 

SECOND 

I 

// 

000466 

2391S 

SECT 

J 

// 

000145 

2391S 

SHTADD 

R 

.000000 

2390S 

SHTN 

I 

// 

000236 

2391S 

2402 

2410 

2412H  2414 

SHCHSS 

R 

EXTERNAL 

OOOCCO 

2416 

2417 

2418 

2420 

STS 

J 

// 

000133 

2391  S 

TIT 

J 

// 

000010 

2391S 

TTIT 

J 

// 

000467 

2391  S 

VEH 

I. 

// 

000141 

2391S 

000064 

2396 

2397D 

_100. 

000306 

2412D 

2415 

_105 

0CC336 

2402 

2406 

24140 

000155 

2399 

2400D 

16 

000171 

2402D 

2413 

_2  0 

000221 

2403 

24050 

200 

000361 

2412 

2416D 

000230 

2401 

2404 

2407D 

5 

000057 

2396D 

2399 

OOUO  ERRORS  C <SHT ADD>FT N-R E VI A . 2 3 
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(2A23) 
(2A2A)  C 
(2A2A)  C 
(242A)  C 
(2A24) 
(242'.) 
(2A2'i> 
<2<t2'i ) 

<2A2't>  C 
<2‘t2A>  C 
(2A2A)  C 
(2,42A) 
(2A2'4> 
(2'»2A) 

( 2 A 2 A > 
(2A2't) 
(2<(2A) 
(2A24)  C 
(2A2A)  C 
(2A25)  C 

<2't26> 

(2^27)  C 
(2A2B)  C 
(2A2S)  C 
(2430)  C 
(2431  ) 
(2452) 
(2433)  2 

(2434)  1 

(2435) 
(2436)  10 

(2437) 
(2438) 
(2439) 
(2440)  5 

(2441)  3 

(2442) 
(2443)  C 
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COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

COMMON  DRAU,TIT,PTIT,DT»SYS,VEH,SECT»NSHTtFREV»FNEO.FEQREF, 
1 ORW,SHTN,REV,NEO»EOREF* 

1 EON*ETIT»EPTIT,EOREV,EDTtERDT,EOVEH. 

1 Rt IDR»INEO,KNT,FI RST, SECOND* TTIT 

DATA  DECLARATION  SLOCK  FOR  THE  DRAU-EO  FILE 


INTEGER*4 

1 

1 

INTEGER*2 

1 

1 


DRAU(4) ,TIT(21) fPTIT(19),SYS{3)»SECT(3) »FEQREF(10*2)  * 
DRW(4),EOREFtlO,2)*EPTIT(19)»ETIT(21)*EON(2) f 
IDR(4),KNT,TTIT(19) 

DT(3)*VEri(2»2)*NSHT,SHTN(2) » FR EV * FNEO* REV t NEO * 
E0REV,EDT(3) f ERDT(3) ,E0VEH(2»2) tR,INE0* 

FIRSTfSECOND 


INTEGER»2  IER(3),I0PT 

THIS  ROUTINE  PROVIDES  THE  BASIC  I/O  FOR  THE 
E.O.  SUBFILE  INPUT/REVISE  ROUTINES 

I£0A0D=0 

IF(R.EQ.O)  GO  TO  100 
URITE(1«1) 

FORMAT!*  HOU  MANY  ITEMS  DO  YOU  UISH  TO  REVISE  (MAX  OF  6)*«/) 

READ (It 10,ERR=2) IKNT 

F0RKAT(I3) 

IF(IKNT.LT.O)  GO  TO  2 
IF(IKNT.GT.6)  GO  TO  2 
DO  3800  LOOPrltlKNTtl 
URITE(lt3) 

FCRHAT(*  INPUT  THE  ITEM  NUMBER  THAT  YOU  UISH  TO  REVISE**/) 
READ(1*10*ERR=5)IR 


J 


) 
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!2A4A) 

C 

!2^45> 

C 

!2446J 

100 

! 2447) 

103 

!2<!48) 

101 

!2449) 

!2450) 

!2451) 

!2452) 

102 

! 2,4  5 3) 

. 

!2454) 

!2455) 

105 

! 2456) 

!2457) 

110 

!2458.' 

200 

!24r39) 

!2460) 

201 

!2461) 

202 

!2462) 

!2463) 

! 2464) 

203 

!2465) 

!2466) 

300 

!246?) 

400 

!2468) 

401 

!2469) 

501 

!2470) 

! 2471) 

502 

!2472) 

!2473) 

900 

!2474) 

901 

!2475) 

902 

!2476) 

!2477) 

903 

!2478) 

!2479) 

1000 

!2480) 

1001 

!2481) 

1002 

BEGIN  INPUT 

IFCR.EQ.l  .AND.IR.NE.l)  GO  TO  200 
WRITE(1,101) 

FORMAT(»  (1)  TITLE  (7  WORDS  - 10  CH AR .)»,/♦!•» 76X, »!*/ ) 
LEN=10 

CALL  TINPUT(ETIT,LEN) 

URITE(lfl02)ETIT 
FORflAKII  lX»2AAfA2)  /) 

DO  105  L=l,19 
EPTIT(L)=PTIT(L) 

CONTINUE 

WRITEd  »110)EPTIT 
FORMAT! IX, 19AA) 

IF(R.EQ.l.AND.IR.Nf.2)  GO  TO  300 
IF(R.EQ.O. AND. FIRST. EQ.l)  GOTO  300 
URITE(1,202> 

FORMAT!’  !2)  E.O.  NUMBER*,/ 
l*!*,8X,*!*/> 

READ!1,203,ERR=201)EON 

F0RNAT!1X,2AA) 

WRITE!1 ,203) EON 
CONTINUE 

IF!R.£G.1.AND.IR.NE.3)  GO  TO  900 
URITE!1,5C1) 

FORMAT!*  !3)  REVISION:  IF  NONE,  ENTER  NC*,/,*!  ! */) 

READ!1,502,ERR=A01)EOREV 
F0RHAT!1X,1A2) 

URITE!1,502)EOREV 
IF!R.EQ.1.AND.IR.NE.4)  GO  TO  1000 
URITE!1,902) 

FORMAT!*  !<()  E.O.  D ATE*  , / , * ! MHDD  Y Y ! • / ) 

READ  !1, 903, ERR  = 901)EDT 
F0RMAT!1X,3I2) 

WRITEII,903)EDT 

IF!R.EQ.l .AND. IR.NE.5)  GOTO  1200 
URITE!1,1002) 

FORMAT!  *!5)  E.O.  REVISION  DATE*,/,*!MHDDYY!*/) 


I 


* 
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(2‘»82> 

(2483) 

(2484) 

(2485) 

(2486) 

(2487) 

(2468) 

(2489) 

(2490) 

(2491) 

(2492) 

(2493) 

(2494) 

(2495) 

(2496) 

(2497) 

(2498) 

(2499) 

(2500) 
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READ( 1»903,ERR=1001 )ERDT 
URITE(lf903)ERDT 

1200  1F(R.EQ.1.AND.IR.NE.6)  GOTO  2200 

1201  URITE(1»1202) 

1202  FORMAT(*  (6)  VEH  I CLE ♦ » /2 ( * ! !*)/) 

READ(1,1203.ERR=1201)((EOVEH(I,J),J=1,2),I=1,2) 

1203  F0RHAT(2(1X,I3,A1,1X)) 

WRITE (1 *1203)  ((E0VEH(I,J),J=1,?),I=1,2) 

2200  CONTINUE 
3800  CONTINUE 
C 

C IF  E.O.  IS  A NEW  ENTRY*  UPDATE  SHEET  DATA  SUBFILE 

C AND  CHECK  FOR  WARNING  MESSAGES 

C 

IF(R.EQ.O. AND. FIRST. EQ.l)  RETURN 

IF(R.EQ.O)  CALL  NEOADD 

CALL  SHOWED 

RETURN 

END 
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N^, 


DRAU 

J 

H 

oooooo 

2424S 

DRW 

J 

// 

000226 

2424S 

OT 

I 

n 

000130 

2424S 

EOT 

I 

N 

000437 

2424S 

2476M 

2478 

LON 

J 

// 

000312 

2424S 

2463H 

2465 

EOREF 

J 

It 

000242 

2424S 

EOREV 

I 

// 

000436 

24243 

2470M 

2472 

EOVEH 

I 

// 

000445 

2424S 

2487M 

2489 

EPT  IT 

J 

// 

000370 

2424S 

2454H 

2456 

ERDT 

I 

// 

000442 

2424S 

2482K 

2483 

ETIT 

J 

// 

000316 

2 4 2 4 S 

2450  A 

2451 

FEOREF 

J 

II 

000156 

2424  S 

FIRST 

I 

// 

000465 

2424S 

2459 

2496 

FriEO 

I 

// 

000155 

2424  S 

FREV 

I 

// 

000154 

2424S 

I 

I 

001067 

2437H 

2489H 

lOR 

J 

// 

000452 

2424S 

lEOAOD 

I 

001070 

2431M 

lEP. 

I 

000002 

2426S 

IKNT 

I 

001071 

2435M 

2437 

2436 

INEO 

I 

n 

000462 

2424  S 

irjpsE 

I 

oooooo 

2423S 

I OPT 

I 

oooooo 

2426S 

IR 

I 

001072 

2442M 

2446 

2458 

J 

I 

001073 

2487M 

2489H 

KNT 

J 

// 

000463 

2424S 

L 

I 

001074 

2453, X 

2454 

LEN 

I 

001077 

2449.M 

2450  A 

LOOP 

I 

001100 

2439M 

NEO 

I 

// 

000241 

2424  S 

NECAOD 

I 

EXTERNAL 

oooooo 

2497 

NSHT 

I 

// 

000153 

2424S 

PTIT 

J 

n 

000062 

2424S 

2454 

R 

I 

n 

000451 

2424S 

2432 

2446 

24  79 

2484 

2496 

REV 

I 

// 

000240 

2424  S 

SECOND 

1 

// 

000466 

24  24S 

SECT 

J 

// 

000145 

2424S 

2^39 


245fl 

2497 


2473  2479  2484 


2459  2467  2473 


D-178 


SUBROUTINE  INPSE 


SHOWE;') 

R 

external 

000000 

2A98 

SHTN 

I 

// 

000236 

2A2AS 

SYS 

J 

// 

0C0133 

2A2AS 

T INPUT 

R 

external 

000  000 

2A50 

TIT 

J 

// 

000010 

2A2AS 

TTIT 

J 

// 

000A67 

2A2AS 

VEH 

I 

// 

ooom 

2A2AS 

_1 

000021 

2A33 

24340 

IlO 

000066 

2A35 

24360 

2442 

_10  0 

COD  ISA 

2A32 

24460 

_100  0 

000577 

2A73 

24790 

_1001 

00061A 

2A80D 

24  82 

_1002 

000620 

2A8  0 

24810 

_101 

0C017A 

2AA7 

24480 

_102 

0002A5 

2A51 

24520 

IlC3 

000170 

2AA7D 

_105 

00C271 

2A53 

24550 

_110 

000307 

2456 

24570 

_1200 

000665 

2479 

24840 

_1201 

000700 

24S5D 

2487 

_1202 

0007CA 

2485 

24860 

_1203 

0CC765 

2487 

24880 

2489 

_2 

OOOOIA 

24330 

2435 

2437 

_2  0 0 • 

000315 

2446 

24580 

_2  01 

0C03A 1 

24600 

2463 

_202 

0003A5 

2460 

24610 

_2  0 3 

GOOAOO 

2463 

24640 

2465 

_2200 

001032 

2484 

24900 

_3 

000110 

2440 

2 4 410 

_3  0 0 

OOOA15 

2458 

2459 

24660 

_3800 

001032 

2439 

24  910 

_A00  , 

OOOA15 

24670 

_A01 

000A31 

24680 

24  70 

OOOlOA 

24400 

2442 

_S3i 

OOOA35 

2463 

24690 

_502 

000 A76 

2470 

24710 

2472 

Iboo 

000512 

2467 

24730 
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_901  000525  2^7SO  7Alb 

_^02  000531  247't  2475D 

-903  000563  2476  2477D 

0000  ;:RR0RS  CCNPSE  >FTN-REV14.20 


a 

I 
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2478  2482  2483 
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<2501>  SUBROUTINE  NEOADD 

(2502)  C 

(2502)  C COMMON  BLOCK  FOR  THE  DRAW-EO  FILE 

(2502)  C 

‘2502)  COMMON  DR AU , T IT f PT I T ,DT t S YS » VEH » S ECT » NSHTt FREV * FNEO t FEO REF » 

<2502)  1 DRU,SHTN,REV,NEO,EOREF, 

‘2502)  1 EON,ETIT,EPTIT,EOREVfEDT,ERDT,EOVEH, 

(2502)  1 R* IDR* INEOtKNTtF IRST«SECOND»TTIT 

(2502)  C 

(2502)  C DATA  DECLARATION  BLOCK  FOR  THE  DRAU-EO  FILE 

(2502)  C 

‘2502)  INTEGER*^  DR A W ( A ) , T I T ( 2 1 ) t PT I T ( 1 9 ) , S YS ( 3 ) , SECT ( 3 ) ,FEOREF ( 1 0 »2 ) , 

‘2502)  1 ORU(A),E0REF(10*2),EPTIT(19),ETIT(21),EON(2) . 

‘2502)  1 IDR( A),KNT,TTIT(19) 

‘2502)  INTEGER*2  DT ( 3 ) tVEH ( 2 ♦ 2 ) » NSHT * SHTN ( 2) t FR EV « FNEO * RE V, NEO . 

‘2502)  1 E:OREV,ECT(3),ERDT(3),EOVEH(2,2),R,INEO, 

‘2502)  1 FIRST, SECOND 

(2502)  C 

(2502)  C 

(2503)  C SYSCOM>KEYS.F  MNEMONIC  KEYS  FOR  FILE  SYSTEM  (FTN)  31  MAY,  1977 

(2503)  NOLIST 

‘25CA)  INTEGER*2  FINI SH, I OPT , I ANS »I SHT ( 2 ) 

^ (2505)  1 URITE(1,2) 

(2506)  2 FORMAT(»  HOW  MANY  DRAWINGS  DOES  THIS  E.O.  REFERENCE’) 

(2507)  READ(1,3,ERR=1 ) lOPT 

(2508)  3 FORMAT(I2) 

(2509)  IF(IOPT.LE.O)  GOTO  1 

(2510)  DO  300  I=l,IOPT 

(2511)  REWIND  12 

(2512)  A WRITE(1,5) 

(2513)  5 FORMAK*  WHAT  IS  THE  DRAWING  NUMBER  •»/,*!»,  1 AX  »•!» ) 

(251A)  READ(1,6,ERR=A)I0R 

(2515)  6 FORMAK  IX, 3AA,A2) 

(2516)  7 WRITE(1,8) 

(2517)  8 FORMAK*  HOW  MANY  SHEETS  OF  THIS  DRAWING  ARE  REFERENCED  BY  THIS  *, 

(2518)  l*E.O.») 

(2519)  READd  ,3,ERR  = 7)  IANS 

(2520)  IF(IANS.LE.O)  GOTO  7 


i 
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{2521.t 

DO  250  J=1,IANS 

(2522) 

12 

URITE(lil3) 

(2523  ? 

13 

FORHAT(«  WHAT  IS  THE  SHEET  NUMBER!  EXAMPLE  SHEET#  2.1  I02!!10!* 

(252A  1 

1./.*!  !!  !»/) 

(2525) 

READ(1»15«ERR=12)(ISHT(N),N=1,2) 

(2526) 

15 

F0RHAT(lX.I2t2X,I2) 

(2527) 

IF(ISHT(1).LE.C)  GOTO  12 

(2528) 

IF ( ISHT( 1 ) .LQ. 1 . AND.  ISHT (2) .EO.O ) GOTO  255 

(2529) 

CALL  SRCH$l(KIKOWR*KSNDAHf *STEKP  »i6*10.1,IC) 

( 2530 ) 

• 

FINISH=0 

(2531  ) 

REWIND  12 

(2532) 

10 

READ(12»ENO=200)DRW»SHTN,REV«NEO»EOREF 

(2533) 

IF(FINISH.EG.l)  GOTO  100 

(2534) 

DO  20  L=l»4 

(2535) 

IF(IDR(L) .NE.DRW(L) ) GOTO  100 

(2536> 

20 

CONTINUE 

(2537) 

DO  25  N=l,2 

(2536: 

IF(ISHT(N).NE.SHTN(N))  GOTO  100 

(2539: 

25 

CONTINUE 

(2540) 

NEO=NEO+l 

(2541) 

IF(NEO.E3.4)  WRITE(1,30)  ( ISHT ( N ) ,N=1 » 2 ) tDRW 

(2542) 

IF(NE0.EQ.5)  WRITE(1*40)  ( ISHT ( N ) , N=1 , 2 ) i DRW 

(2543) 

IF(NE0.GE.6)  WRITE(1.50)  ( I SH T ( N ) , N=1 t 2 ) « DR W » NEO 

(2544) 

30 

FORMAT! IX, 54(  •»•) f/,  » WARNING!*!  SHEET#  * , 1 2 , • . • , 1 2 , * FOR  DRAWING 

(2545) 

1»,3A4,A2,/,12X,»N0W  HAS  FOUR  E .0  . » * S • , / , 1 X , 54 ( » * • ) ) 

(2546) 

40 

F0RMAT(lX,61('*»),/,»  ATTENTION!!!  SHEET#  • , 1 2 , • . • , 1 2 , • FOR  DRAWIN 

(2547) 

IG  ’fSAA.AB,/,*  NOW  HAS  THE  MAXIMUM  ALLOWABLE  OF  FIVf  E.O.'»S»,/, 

(2548) 

llX,6i(***)) 

(2549) 

50 

F0RMAT(1X,75< ♦*»),/, » ATTENTION!!!  IMPORTANT!!!  RE V I S I ON  P AS T • , 

(2  550) 

I’DUE!!  IMMEDIATE  ACTION  REQUIRED!!*,/,*  SHE ET « * , 12 , * . * , 1 2 , * FOR  D 

(2551) 

IRAWING  *,3A4,A2,*  NOW  HAS  *,I2,*  E . 0 . * * S * , / , 1 X , 75 ( * * * ) ) 

( 2552) 

DO  150  K=l,2 

(2553) 

EOREF(NEO,K)-EON(K) 

(2554  ) 

150 

CONTINUE 

(2555) 

IF(d.EQ.I ANS)  FINISH=1 

(2556) 

100 

WRITE(14)  DRW,SHTN,REV,NEO,EOREF 

(2557) 

GO  TO  10 

(2558) 

255 

CONTINUE 

0179 
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f2559J  CALL  SRCH$S(KtRDWR+K$NDA«» *TEMP 

(2560)  FINISH=0 

(2561J  REWIND  6 

<2562;  ISHT(1)=1 

<2563>  ISHT(2)=0 

(256A)  260  RLAD(6»END=285)DRAU,TIT,PTIT,DT,SYS,VEH,SECT,NSHT,FREV*FNE0, 

(2565)  1 FEOREF 

(2566)  IF(FINISH.EQ.l)  GOTO  275 

(2567)  DO  265  L=1,A 

(2568)  IF  ( I DR (L) .NE.OK AW <L ) ) GOTO  275 

(2569)  265  CONTINUE 

(2570)  FNEO=FNEO+l 

‘2571)  ir(FNEO.EQ.A)  URITr(l,30)  ( ISHT ( N ) ,N= 1 , 2 ) , DRAW 

‘2572)  IF  (FNE0.EQ.5)  WRITFdfAO)  ( I SHT  < N ) » N = 1 » 2 ) * DR  AW 

‘2573)  IF(FNEC.GE.6)  WRITE(1,50)  (ISHT(N),N=l»2)*DRAU»FNEO 

(257A)  ■ DO  270  K=l,2 

.(2575)  FEOREF(FNEO,K)  = EON(K) 

(2576)  270  CONTINUE 

(2577)  FINISH=1 

(2578)  275  URITE(IO)  DR AW » TI T t PT I T » DTtSYS * VEH ,S ECT » NSHT , FREV « FNEO , FEOREF 

(2579)  GO  TO  260 

(2580)  285  CALL  SR CH $$ ( KSCLO S , » TEMP  'tStOfOtO) 

‘2581)  CALL  S.RCHSS  (KSCLOSf ’DRAW  **6, 0*0,0) 

‘2582)  CALL  SRC.HSS  ( KtCELE  , ’DRAW  *,6,0, 0,0) 

(2583)  CALL  CNAM$$<*T£MP  »,6,»ORAW  *,6,IC) 

‘258A)  CALL  S.RCH$$(K$RDWR*K$NDAH,*ORAW  *,6,2,1,10 

(2585)  FINISH=0 

(2586)  GO  TO  250 

(2587)  200  CALL  SR CHSS ( KSCLOS ,* SHEET  *,6,0, 0,0) 

‘2588)  CALL  SRCH$$(K$CLOS,*STEMP  *,6,0, 0,0) 

‘2589)  CALL  SRCH S$ ( K SOELE , * SHFE T *,6,0, 0,0) 

‘2590)  CALL  CNAN $J ( * ST£M=  *, 6, ’SHEET  *,6,IC) 

‘2591)  CALL  SRCH$$<K$HDWR*K$NOAH,*SHEET  ’,6,8,1,10 

(2592)  FINISH=0 

(2593)  250  CONTINUE 

(2599)  300  CONTINUE 

(2595)  RETURN 

(2596)  END  ‘ . 
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R 

external 
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ORA'.' 

J 

It 
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J 
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DT 

I 

n 

000130 
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I 
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J 

// 

000312 
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2575 

EOREF 

J 

// 
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EOREV 

I 

ft 
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EO  V.TH 

I 

n 

000445 

2502S 

EPTIT 

J 

// 

000370 

2502S 

EROT 

I 

// 

000442 

2502S 

EXIT 

J 

// 

000316 

2502S 

FEOREF 

J 

// 

000156 

25Q2S 

2564H 

2575M 

2578 

FINISH 

I 

001757 

2504S 

2530M 

2533 

2555M 

258.5M 

2592M 

FIRST 

I 

// 

000465 

25023' 

FNEO 

I 

// 

000155 

2502S 

2564H 

2570M 

2571 

25  7 8 

FREV 

I 

// 

000154 

25C2S 

2564M 

2578 

I 

I 

001760 
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IANS 

I 

001762 

. 2504S 

2519H 
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IC 

I 

001763 
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255SA 

2583A 
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J 

// 

000452 

2502S 

2 5 1 4 M 

2535 

2 56  8 

I NED  ' 

I 

// 

000462 

2502S 

lOPI 

I 

001764 

2504S 

2507M 

2509 

2510 

ISHT 

I 

000002 

2504S 

2525H 

2527 

2528 

2543 

2562M 

2563M 

2571 

J 

I 

001765 

2521  M 

2555 

K 

I 

001766 

2552M 

2553 

2574M 

2575 

KSALLO 

I 

PARAMETER 

2503S 

KSCACC 

I 

PARAMETER 

25G3S 

KSCLOS 

I 

PARAMETER 

2503S 

2580 

2581 

2587 

KSCONV 

I 

PARAMETER 

2503S 

KSCURR 

I 

PARAMETER 

2503S 

KSDEl.E 

I 

PARAMETER 

2503S 

2582 

2589 

KSDMPB 

I 

PARAMETER 

2503S 

KID! IM 

I 

PARAMETER 

2503S 

K$EN?R 

I 

000000 

2503S 
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2572  2573  2578 

25A2  2543  2556 


2560M  2566  2577M 

2572  2573  2575 

2555 

2590A  2591A 

2538  2541  2542 

2572  2573 
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0 

1 


C» 

cr 


KSEX3T 

1 

PARAMETER 

2503S 

KSGC.ND 

I 

PARAMETER 

2503S 

KSGPOS 

I 

PARAMETER 

2503S 

K$H0«E 

I 

PARAMETER 

2503S 

RSICl.'R 

I 

PARAMETER 

2503S 

KSIMFD 

I 

PARAMETER 

25C3S 

KSIR7N 

I 

PARAMETER 

25  03S 

KSISEG 

I 

PARAMETER 

25C3S 

KIIUFO 

I 

PARAMETER 

2503R 

KSHENT. 

I 

000000 

2503S 

K$«SI2 

I 

PARAMETER 

2503S 

KIMVNT 

I 

PARAMETER 

25C3S 

KSNDAM 

I 

PARAMETER 

2503S 

KSNRTN 

I 

PARAMETER 

25C3S 

KSNBAH 

I 

PARAMETER 

2503S 

KSNS3D 

I 

PARAMETER 

2503i; 

KiNSGS 

I 

PARAMETER 

2503S 

KSPOSA 

I 

PARAMETER 

2503S 

KSPOSN 

I 

PARAMETER 

25C3S 

KSPOSR 

I 

PARAMETER 

2503S 

KSPREA 

I 

PARAMETER 

2503S 

KiPRKR 

I 

PARAMETER 

25C3S 

KSPRCT 

I 

PARAMETER 

25C3S 

KSRD'.'R 

I 

PARAMETER 

25C3S 

KSREAD 

I 

PARAMETER 

2503S 

KJRPOS 

I 

PARAMETER 

2503S 

KSRSUB 

I 

PARAMETER 

2503S 

KSRWLK 

I 

PARAMETER 

2503S 

KSSENT 

I 

000000 

2503S 

KISETC 

I 

PARAMETER 

25C3S 

XSSLTH 

I 

PARAMETER 

2503R 

KSSPOS 

I 

PARAMETER 

2503S 

RJSRTN 

I 

PARAMETER 

25  0 3S 

K5TRNC 

I 

PARAMETER 

2503S 

KSUPOS 

I 

PARAMETER 

2503S 

KSURIT 

I 

PARAMETER 

2503S 

KNT 

J 

//  000463 

2502S 

L 

I 

001767 

2534  M 

2529 


2529 


2535 


2559  258A 


2559  258A 


2567M  2568 


2591 
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N 

I 

001771 
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2572K 

2573H 

NEO 

I 

// 

000241 

2502S 

2556 
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2540H 

2541 

2542 

NEOADD 

I 

000000 

2501  S 

NSHT 

I 

// 

000153 
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2564H 

2578 
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J 

// 

000052 

2502S 
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2578 

R 

I 

// 

C00451 

2502S 

REV 

I 

// 

000240 

2502S 

2532H 

2556 

SECOND 

I 

// 

000466 

2502S 

SECT 

J 

// 

C00145 

2502S 

2564H 

2578 

SHTN 

I 

// 

000236 

2502S 

2532M 

2538 

2556 

SRCHSS 

R 

EXTERNAL 

000000 
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2559 

2580 

2581 

2582 

25P6 

2589 

2591 

SYS 

J 

// 

000133 
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2578 

TIT 

J 

// 

000010 

2502S 

2564M 

2578 

TTIT 

J 

// 

000467 

2502S 
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I 

// 
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2578 

1 
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I3 
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SUBR  CHKLIN 


* 

4 


SUliR  CHKLIN 

REL 

Cfc'tR 


all  CHKLIN(ICHAH) 

HtN  ICHAR  IS  NOT  tOUAL  TO  .TRO 
lOTf  THE  FIRST  CHAR  IN  THf  lUFFF.R 
n THf  FIHF.T  CHAR  A SFACt 


(0)  A CHAR  I 
IS  LOST 


IN  THF.  HUFFF.R 


CHKLIN  DAC 

* • 

LOX 

CHKLIN 

CRA 

SKS 

*704 

JHP 

*♦2 

CALL 

TUB 

STA* 

Otl 

JHP 

1«1 

END 

Figure  3 
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SUriROUTINt  JTIi  > 


( I YP  ♦ MON*  1 1)  A « I HH  f M Sr  C » T JUL  ) 


SUBROUTINE  JTIME( lYR  «M0N*IPA,1HR»M1N*SEC*TJUL ) 

double  precision  TJUL 
SOAY=0 

DO  1 LTB=1*H0N 
if(ltb.eq.mon)  go  to  2 

IF(LTB°eG.1°0R.LTD.EQ.3)  SDAY=SDAY+1.0 
IF(LTB*E0.5»0R.LIB»EQ.7)  SDAY=S0AY+1*0 

IF<LTB.E0.8.0R.LTB.EQ.10)SDAY=SDAY*1.0 

IF(LTB.EQ.12)  SO AY=SOAY* 1 . 0 

IF<LTB.NE.2>  GO  TO  3 
IYC  = IABS(IRY-190‘i) 

AYC=1YC 

AKT=AM0D<AYCt9.0) 

IFtAKT.LT. 0.1)  SDAY=SDAY-1.0 

IF(AKT.GE.O.l)  SDAY=SDAY-2.0 

CONTINUE 

CONTINUE 

CONTINUE 

OAY=IDA 

IYC=(IABS(IYR-1901) )/A 
AYC=IYC 

SDAY=SDAY+DAY+AYC 

HR=IHR 

DJJX  = SDAY*(HR/2A.)*<AHIN/l<iAO.O)^tSEC/86AOO.O) 

TJUL=365.0*HTR-1900.0)+DJJX*2A15019.5 

RETURN 

END 
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Figure  1 


c 

SINSERT  SYSCOM>KEYS.F 
INTtGER  BUFF(BO) 

INTEGER*'*  J 
INTEGER*2  I0D(3) 

CALL  OPEN 
J = 0 

CALL  C0HINP(6HTTY  ,1) 

3 URlTEIlt5) 

b FORHATdXt 'ENTER  DATE  OF  TAPE:  HHDDYY') 

REAOCl tG«ERR=3)  100 
REUINO  14 
UKITE<14,7)  100 
7 F0RHAT(1X»3I2) 

6 F0RMAT(3I2) 

REUINO  14 

10  REAO(6»100,LNO=900)  ( bUFF ( 1 ) , I =1 , 80 ) 

100  FORHAT(BOAl) 

IF (BUFF< 7) .NE. 'P» ) GOTO  101 
DO  210  I=7tl5 
BUFFd  » = BUFF(I*1> 

210  CONTINUE 

BUFFd6)  = »P» 


I » ' 


I 


I 

CO 


aoi 


103 


90 

102 


900 


905 


IF(BUFF(63).eq..  t)  goto  101 

IF(BUFF(69).NE..  . gotS  103 

BUFF(6«)  = tNt  “3 

BUFF (65)  = *c  * 

JoirjiJi;;"'-”” 

BUFF(M)=to» 

CONTINUE 

^ ( 7#  1 0 0 ) (BUFFcti  t -•» 


' t 6i Of  OtO) 

**6«0t0«0) 


SO  TO  10 

CALL  SRCH»t(K$CL0S,tDDAT4 

cln  ....u.G.o, 

'.^.0.0.0, 

CALL  Exn***^’  IN  ThE  DRAUNC  DATA*/) 

END 

SUBROUTINE  OPEN 
tlNSLRT  SYSCOH>kEYS.F 

Ca'u  •*C.2,I.IC) 

CALL  SRCHSJ (KiHDUR^KSNnAW  tnn  ’•^»3«1»IC) 
REUIND  6 •'»«i^“R*KJNDAH,tDDATE  *.£,10,1,10 

rewind  7 
rewind  u 
return 
end 
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Figure  2 


uuuu 

u 

u 

u 

u 

u u 

u 

u 

u 

u 

u u 

u 

u 

u 

w 

u u 

uu 

uuuuu 

u u 

u 

u 

u 

u 

u u 

u 

u 

u 

u 

uuuu 

u 

u 

u 

u 

uuuu 

u 

u 

uuu 

uuu 

uuuuu 

uuu 

u u 

u 

u 

u 

u 

u u 

u 

u u 

u u 

u 

u 

u 

u 

u 

u 

u 

uuuu 

uuuuu 

uuuuu 

uuu 

uuuu 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u 

u u 

u 

u 

u 

u 

u 

u 

u 

uuu 

uuuuu 

uuuuu 

i*************i 


i****************************i 


c 

IINSCRT  COMMON 
IINSERT  SYSCOM>KLYS.F< 

INTEGER  BUFF(3P)tBUF (80) 

INTEGER*4  J J t MM« NN « LL * KK « NU« MN* TEN 
CALL  OPEN 
JJ  = 0 

CALL  C0HINP(6HTTY  tl) 

10  READ  (7*100tENO  = '»00)  SYS«SHTNt  ( B UFF  ( I ) » I = 1 1 3 1 ) t E 0N»  EOR  EV  , RE  V t 

1 (BUFFIK) *K=33»38) 

TOO  FORMAT (2AA,A2*2I2 tlXf 31 A1 tlA4«A2 «A2«A2«2X»3A1 «1X«3A1 ) 
BUFF<32)=*  » 

IF(BUFF(36).EU.*S»)  GOTO  800 
REUINO  10 

URITE( lOtTOO)  (BUFF(K)«K=33t38) 

700  F0RMAT(2(1X.3A1»»  •)) 

REUINO  10 

REAO(10«705fERR=10)  ((VEH(ItJ)*J=l*2)«I=l«?> 

70b  F0RMAT(2(IXtI3fAl)) 

GO  TO  707 
800  CONTINUE 
REUINO  10 

URITE(10»710)  (BUFF (K) tK=33,35) 

710  FORHAT(lX«3Alt*S**lX,»000  •) 

REUINO  10  ^ 


4 


) 


n 


^ c!n 


READ(10»705fERR=10)  ( < V EH ( I « J) t J= 1 »2 > » 1 = 1 1 2 > 
707  CONTINUE 

KEUIND  13 

WRITE(13,750)  (BUFF (K) *K  = 1 .32) 

750  F0RHAT(1X.32A1) 

REWIND  13 

READU3.760.ERR=10)  PTIT 
760  F0RHAT(1X«19AA ) 

REWIND  13 
TEN  = 0 

DO  805  1=1.80 
BUF(I)=*  • 

805  CONTINUE 

NW  = 2 


811 

315 


820 

BIO 

8A0 

>850 

,C102 

C 

C500 


HN  = 2 

BUF(1)=DUFF(1) 

DO  810  KH=2.31 
IF(MN.LE.80)  goto  811 


HH=31 
GO  TO  BIO 
IF(TEN.EQ.O)  GOTO 
IF (BUFF (MM ) .EQ» * *• 


B 1 5 

OR.BUFF(MM).EO 


f 


*’lF(BUFF(MM)  .EQ.»  • . OR. BUFF ( MM)  .EO. 
BUF(MN)=BUFF (MM) 


« 


. 


•) 

.♦) 


TfN  = 0 
GOTO  820 


MN  = MN«-1 
NU=NW«1 

IF(NW.LE.IO)  GOTO  810 


NW  = 1 
HN  = MN  + 1 
TEN=1 
GO  TO  810 
LL=(10-NW)*1 
NN=MN*LL 
MN=NN*1 


NW  = 1 

CONTINUE 

REWIND  13  ' . T 1 ..n» 

WRITE(13.8A0)  (BUF(I).I-1»00) 

FORMAT(1X.80A1) 

REWIND  13 
REAO(13,B50)  TIT 
F0RMAT(7(1X.2A4.A2)) 

REWIND  13 
DRW(1)=SYS(1) 

DRW( 2)=STS(2) 

DRW(3)=SYS(3)  ^ 

“"“ISlTEd.bJo)  D«W.SHTN,FON.EOREV.REV,((VEH(I,J).J  = 

3:h?i:^I!I:I!L.?(I2.1X),3X.lAA.A2.3X.A2,3X.A2. 


1.2). 


I 


c e 3X»Z(lX»I3»Al)»/tlX.19A<it/i7nx»2A'(«A?)t/tlX,lH0) 

200  JJ=JJ»1 

URITE(lt)DRU«TlTfPTIT»SHTNiREV*VfH*CON»EOf;t;V 

GO  TO  10 

900  CALL  SRCHSSCKlCLOSt 'NEW  '.GtOfOtO) 

CALL  SRCH$S<KiCLOS» *VV  •♦6*0»0»0) 

CALL  SRCH$$(K$DELE» »VV  »*6t0»0»0) 

CALL  SRCH$$(KtCL0St •TITLES* tb»0»0*0) 

CALL  SRCH1S(K»DELE»»T1TLES« *6»0»0*0) 

CALL  SRCH$$(K1CL0S»*FINAL  'tfetO^OtO) 

URITE(1«1000>  JJ 
1000  F0RMATaX,I4»*  RECORDS*/) 

CALL  EXIT 
END 

SUBROUTINE  OPEN 
SINSERT  SYSCOM>KEYS.F 

CALL  SRCHlV(K$ftOUR'*K$NDAHt*NEW  »»6»3tl«lC) 

CALL  SRCHJ»(KJRDWR*K»NOAH»*VV  *«f.t6*l*IC) 

CALL  SRCHSS (KSRDUR+K$NDAH«* TITLES* fbt 9t 1*1 C) 

CALL  SRCH$S(K3RDUR+K$NUAM,*FINAL  **6*12*1*10 
REWIND  7 
REWIND  10 
REWIND  13 
REWIND  16 
RETURN 
END 
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CO 


SlNStRT  COMMON 
JINSERT  SYSCOM>KEYS.F 

INTEGER*^  E0NN(2) 

INTEGER»2  IDD(3)fJJ 
CALL  OPEN 

CALL  C0MINP(6HTTY  ,1) 

INE0=0 
JJ  = 1 

DO  5 1=1»10 
DO  A J=l,2 
FEOREF(I»J)=*  » 

t CONTINUE 

3 CONTINUE 

DO  6 1=1*3 
SYS<I)=t  I 
SECTm  = » f 
i CONTINUE 

REUIND  lA 

READ(lA.bO)  (IDD(I),I=l  ,3) 

F0RMAT(1X.3I2) 

RE AD (16)  DRAU.TIT  «PTI T »SHT N *FRE V » VFH , EON »EORF V 
IF (EON  (1 ) .EQ.»  •)  GOTO  10 

IF( INEO.EQ.O)  GOTO  210 
DO  201  1=1,2 

IF(FE0REF(INE0,I).NE.E0N(I))  goto  210 
CONTINUE 
GO  TO  10 


50 

200 

201 


210  INE0  = 1NC0-»1 

IFdNEO.GC.ll)  GOTO  10 
FEOREFC INEO«l )=EON(l) 

FEOREF  UNE0»2  )=E0N<2) 

10  READ<16,ENO=8000>  DRU, ET I T . EPT IT t F I RST » SECOND #REV t COVEH t EONN.rt 

C DRU=DRAW  T1T=ET1T  PT1T=EPT1T 

C SHTN=  FIRST  t SECOND  FREVsREV 

C VEH=EOVEH  EON=EONN  E0REV=  R 

C XXXXXXXXXXX  BUILD  DATA  BASE  ! ORAUt  SHEET*  EO 

DO  100  I=l«4 

IF(DRUm.NE.DRAU(l))  GOTO  5000 
100  CONTINUE 

IFIFIRST.EQ.l. AND. SECOND. EO.O)  GOTO  6000 
IFtSHTNID.EQ. FIRST. AND. SHTN(2).EQ. SECOND)  GOTO  10 
dJ=dJ*l 
SHTN(1)=FIRST 
SHTN(2)=SEC0N0 
GO  TO  10 

6000  IF(EONN(  D.EQ.*  •)  GOTO  10 
IFIINEO.EQ.O)  GOTO  6010 

DO  6001  1=1*2 

IF(FEOREF(INEO*I).NE.EONN(I)>  GOTO  6010 

6001  CONTINUE 
GO  TO  10 

6010  INE0=1NE0+1 

IF (INEO.GE.il)  GOTO  10 
FEOREF(INEO»l)=EONN(l) 

FE0REF(INE0*2)=E0NN(2) 

GO  TO  10 

5000  URITE<6)  DR AU * TIT  * PTIT ,1DD »SYS * VEH *SECT « dd* FRE V * I NEO *FEOREF 

DO  15  1=1*21 
TIT(I)=ET1T(I) 

15  CONTINUE 

DO  20  1=1*19 
PTIT{I)=EPTIT<1) 

20  CONTINUE 

DO  30  1=1*4 
DRAU(1)=DRU(1) 

30  CONTINUE 

DO  40  1=1*2 
DO  35  d=l*2 
VEH(I*d)=EOVEH(I*d) 

35  CONTINUE 

40  CONTINUE 

EOREV=R 

EON(l)=EONN(l) 

E0N(2)=E0NN(2) 

FREV=REV 

SHTN(1)=FIRST 


SHTN<2)=SEC0N0 
DO  A2  I=lilO 
DO  43  d=l»2 
FEORFFt I* J):»  • 

43  CONTINUE 

42  CONTINUE 
JJ  = 1 
INEO=0 
GO  TO  200 
8000  REWIND  16 

URITE(6)DRAU»TIT,PTIT*IDDiSYS,VEHiSECTt JJtFliEV, INEO^FEOREF 
CALL  SRCH1S(KSCL0S«'DRAU  'tetOtOtO) 

CALL  BSHT 
END 

SUBROUTINE  OPEN 
IINSERT  $YSCOH>KEYS.F 

CALL  SRCHSKKSRDUR+KSNDAMt 'DRAW  •«6<2tl«IC} 

CALL  SRCHSS(K$ROWR«K}NOAH«*FINAL  •i6«12«l«IC) 

CALL  SRCHSSIKSROUR+KSNDAHt *DDATE  •«6«10tl<IC) 

REWIND  6 
REWIND  16 
REWIND  14 
RETURN 

■n  end 

• SUBROUTINE  BSHT 

" IINSERT  COMMON 

SINSERT  SYSCOM>KEYS.F 

INTEGER*4  E0NN(2) 

INTEGER*2  I0D(3)«JJ 
CALL  OPENN 
INEO=0 
JJ  = 1 

DO  5 1=1*10 

DO  4 J=l*2 

F£OREF(I»JI=*  • 

4 CONTINUE 

5 CONTINUE 

DO  6 1=1*3 

sYS<n=*  » 

SECT<I)=‘  • 

6 CONTINUE 
REWIND  14 

READ(14*D0)  (IDD(Il*I=l*3) 

50  F0RMAT(1X*3I2) 

8510  READ(16*END  = 7000  ) DR W * TI T * PT I T * SHTN * FRE V , VFH * F ON  * L ORE V 

1F(SHTN«1).EQ.1.AND.SHTN(2).EQ.0)  GOTO  0510 
WRITE(12)0RW*SHTN*FREV*E0N 
GO  TO  8510 
7000  INE0=0 

DO  7040  1=1*10 
DO  7050  J=l*2 
FEOREFI  I*J)  = * • 

7050  CONTINUE 
7040  CONTINUE 


F-10 


ReUIND  12 
REWIND  B 

READ(12)  DRAU,SHTN»FREV«EON 

7200  IF (E0N<1 ).EO.»  •>  GOTO  7010 

IF(INEO.EQ.O)  GOTO  7250 

00  7201  1=1»2 

IF(FEOREF(INEO»I).NL.EON<I))  GOTO  7250 

7201  CONTINUE 

GO  TO  7010 
7250  INEO=INEO*1 

IF(INEO.GE.ll)  GOTO  7010 
FE0REF(INE0»1)=E0N{ 1) 

FE0REFtINE0«2)=E0N(2) 

7010  READ<12»END=9000)  DRW » FIRST.SECOND i RE V »E0NN 

DO  7100  I=1»A 

IF(DRU(I).NE.DRAU(1))  GOTO  7500 
7100  CONTINUE 

IF (SHTNI 1 ) »EQ. FIRST. AND. SHTN(2) .EO. SECOND)  GOTO  7700 
7500  WRITEtB)  DR AW tSHTN »FREV » I NEO.FEOKEF 

SHTNll)=FIRST 
SHTN<2)=SEC0ND 
EON(l)=EONN(l) 


7030 

7150 

71A0 

7700 

7701 
7720 


E0N(2)=E0NNl2) 

FREV=REV 
00  7030  1=1. A 
DRAW<I)=ORW(I ) 

CONTINUE 

1NEO=0 

DO  7140  1=1.10 
DO  7150  J=1.2 
FEOREF(I.J)=*  ' 

CONTINUE 
CONTINUE 
GO  TO  7200 

I F (EONN( 1 ) .EG. • •)  GOTO  7010 

IF ( I NEO.EO.O ) GOTO  7720 
DO  7701  1=1.2 

IF  (FEOREFI INEO.  I)  .NE.EONNU)  ) GOTO  7720 
CONTINUE 
GO  TO  7010 
INE0  = 1NF.0^1 

IF(lNEO.GE.ll)  GOTO  7010 

FE0REFnNE0.1)=E0NN(l) 

FE0REF<INE0.2)=E0NN(2) 

GO  TO  7010 


I 


9000  WRITEIBl  DRAW t SHT N»FRE V* I NEO t FEOREF 
CALL  SRCH»$(K*CLOSt»SHEET  (tBtOtOtO) 
CALL  SRCH1$(K$CL0S»»DDATE  «t6«0t0«0) 
CALL  SRCHS$(K$CLOS, ‘FINAL  »,b.0t0,0) 
CALL  SRCH$S(K»CLOS*‘REVS  ♦, 6, 0.0.0) 
CALL  SRCH$S(KJOELE. ‘SHEET  ‘.6. 0.0.0) 
CALL  CNAMESCbHREVS  .6HSHEET  ) 

CALL  EXIT 
END 


SUBROUTINE  OPENN 
SINSERT  SYSCOM>KEYS.F 

CALL  SRCH1$(K$RDUR*KSNDAM. ‘SHEET 
CALL  SRCHS*(K*ROUR.KSNDA!i  . ‘REVS 
REWIND  12 
REWIND  IS 
REWIND  14 
REWIND  B 
RETURN 
END 


‘.6.6.1.10 

•.6.A.1.IC) 
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SIiJSERT  COMMON 
^INSERT  SYSCOH>KEYS.F 

INTEGER*^  EONN(2) 

INTEGER*2  1DD(3)*JJ 
CALL  OPEN 

CALL  C0M1NP(6HTTY  *1  ) 

INEO=0 
JJ  = 1 

DO  5 1=1«10 
DO  A J=l«2 
FEOREF(I»J)=*  ♦ 

A CONTINUE 

5 CONTINUE 

DO  6 I=lf3 
SYS(I)=*  • 

SECT<n  = * • 

(j  CONTINUE 

REUIND  lA 

READ(1A,50)  (IDD(I)*I=1»3) 
bO  F0RMAT<1X.3I2) 

JJ  = 0 

8010  READ(lb»END  = 8bOO>  DRU t T IT tP T IT »SHT N,FRE V , VLH, EON t E OR E V 
IF(E0N(1).EQ.*  •)  GOTO  8010 

REUIND  18 
DO  8015  I=lfl9 
ET1TU)  = » • 

EPT1T(I)=»  • 

8015  CONTINUE  , | 


ETIT(20)=»  » 

ETIT(2n=»  • 

IF(JJ.EQ.l)  GOTO  8020 

URITE(IB)  EONtETITtEPTIT*COREVtIDD»lDO»VEH 
JJ  = 1 

GO  TO  8010 

8020  REAO(18»ENO  = 8O30>  EONN » ET  IT  t EPT 1 T tREV  tEDT * ERDT . EOVF.H 
IF(EON(l).NE.EONN(l) ) GOTO  8020 
IF(E0N(2).NE*E0NN(2))  GOTO  8020 
GO  TO  8010 

8030  UR1TE(18)  EON  , F.T  I T ,EPT  IT  ,EORE  V , IDD  . I DO.  VEH 

GO  TO  8010 
8500  REWIND  16 
ENOFILE  18 

CALL  SRCH$S{KSCLOSf»tO  'iGtOtOtOI 

CALL  SRCH$$<K1CL0S» ‘DDATE  »»6«0«0«0) 

CALL  SRCH$$(KSCLOS«*FINAL  •»6»0»0t0) 

CALL  EXIT 
END 

SUBROUTINE  OPEN 

IINSERT  SYSC0H5KEYS.F  . ^ , ,rt 

CALL  SRCHl$(K$RDUR+KSNDAHt »EO  •t6tlAtl«IC) 

CALL  SRCHtt(KSRDUR*K$NOAHt*FINAL  »»6»12«1»IC> 

CALL  SRCH*S(K»RDUR»K$NDAM» ‘DDATE  »t6»10»ltIC) 

REWIND  16 
KLWIND  1A 
REWIND  18 
RETURN 
END 


Figure  5 
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SINSERT  COHHON 
CALL  OPEN 

CALL  C0HINP(6HTTY  »1  ) 

10  READ<  16fENO=100)  DRU  » T I T «PT  1 TtiiHTN  »RE  V * V EH»  E ON*  E ORE  V 

UR ITE< 1*500)  DRU*SHTN*EON*EOKEV*REV* t tVEHC I * J) *J  = 1*2)*I  = 1*2)» 
1 PTIT*TIT 

50  0 F0RHAT<1X*4AA*3X*2< I2,1X) * 3X * 1 A4 * A2 * 3X * A2 * 3 X * A2  . 

1 3X,2<1X*13.A1)*/*1X*19A4*/*7(1X*2A4*A2) */*lX,lH0) 

GO  TO  10 

100  CALL  SRCH$i(KJCLOS* ’FINAL  ♦*6*0»0*0) 

CALL  EXIT 
END 

SUBROUTINE  OPEN 
tINSERT  SYSCOH>KEYS.F 

CALL  SRCHtS{KlRDUR+KSNDAH«»KlNAL  •*6.12*1*10 

RETURN 

END 
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SINSERT  COHHOtJ 
KNT  = 0 
CALL  OPEN 

20  READ <6»END=1000 ) OR AUt T IT , P T I T iD T tSYS « VEHi SE CT . NSH T » F RE V » FNE 0 t 
1 FEOREF 

URlTE<7«100)ORAUiPTITfOT»C<VEH(IfJ)»J=l,2)»l=tt2)tNSHT,FRFVtFNEO 

100  FORMAT<lX,3AA,A2»3X,19A<t  »/ » 1 Xt3 1 2 ,bX  » 2 C 1 3,  A 1 , 1 X ) » 4X , I 2 ,5  X,  A2  » OX  , 
112) 

URITE(7t200)  C(FEOREF(ItJ),J  = l,2),in,iO) 

200  FORMAT(10(lXt2AA)f/»lXt»  »/) 

KNT=KNT+1 
GO  TO  20 

1000  URITECltlOl)  KNT 

101  FORHATdX,  »THERE  ARF  DRAWINGS*/) 

CALL  CLOSE 

END  . : 

SUBROUTINE  OPEN 
ilNSEKT  SYSCOH>KEYS.F 

CALL  SRCHl${K$ROUR+K$NPAM»*ORAU  **bf2fl«IC) 

CALL  SRCHlS(K»RDUR^K$NSAMf*OUT  **6«3«0f0) 

REUIND  6 

RETURN 

END 

SUBROUTINE  CLOSE 
tINSFRT  SYSCOM>KEYS.F 

CALL  S.RCHSSIKSCLOSi  *DRAU  *t6t0«0«0) 

CALL  SRCH$$(KSCLOS« *OUT  't6«0»0t0) 

CALL  EXIT 
END 


Figure  7 
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sinserT  common 

•KNT=0 
CALL  OPEN 

20  READ(12,LND=1000)  OR AU »SHTN,FRE V. I NEO * FEOREF 

URITE(7tlOO)DRAW»SHTN»FREV.INCO  . 

100  F0RMAT(lXt3A4tA2t3X«I2f*.*tI2t5XfA2«5XfI2> 
URITE<7»101)  ( (FEOREFU  »J)tJ  = l»2)»I  = ltlO) 

101  FORMAT(10<lXf2AA),/,»  »/) 

KNT=KNT*1 
GO  TO  20 

1000  URITE(ltl03)  KNT 

103  F0RMAT(1X,»THERE  ARE  ♦flAt*  SHEETS*/! 

CALL  CLOSE 
END 

SUBROUTINE  OPEN 
SINSERT  SYSCOM>KEYS.F 

CALL  SKCHSSlKlRDUR^KSNOAHt'SHEET  *«btB(l«IC> 
CALL  SRCHS$(K$ROUR*K$NSAM»*SHT  »*6»3t0t0) 
REWIND  12  . 

RETURN 

END 

SUBROUTINE  CLOSE 
SINSERT  SYSCOM>KEYS.F 

CALL  SRCHSKKSCLOSt 'SHEET  *«6«0«0«0) 

CALL  SRCHS$(KSCL0S»'SHT  *t6«0»0»0) 

CALL  EXIT  ■ , 

END  ' ! 
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